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INTRODUCTION 

The 1130 Commercial Subroutine Package has been written to facilitate the use of 
FORTRAN in basic commercial programming. Included in the package are the following 
items: 

• The GET routine, which allows the programmer to decode input records after they 
have been read. This eliminates the common FORTRAN-associated problem that 
occurs when input cards enter the system in an unknown sequence. Input records 
that vary in this way may be read with the Al format and converted to real numbers 
(using GET) after the program has determined which type record was just read. 

• An editing routine, EDIT, for the preparation of output in special formats. With 
EDIT it is possible to insert commas, supply leading blanks, float dollar signs, 
display a CR symbol after negative numbers, etc. EDIT is especially useful in the 
preparation of invoices, checks, and other commercial documents. 

• Code conversion routines for data manipulation and more efficient data packing: 

GET - Al format to Real 

PUT - Real to Al format 

PACK - Al to A2 format 

UNPAC - A2 to Al format 

A1A3 - Al to A3 format 

A3A1 - A3 to Al format 

DPACK - Dl to D4 format 

DUNPK - D4 to Dl format 

A1DEC - Al to decimal format 

DECA1 - Decimal to Al format 

• A variable-length decimal arithmetic package. In this system, all arithmetic is done 
with integer or decimal numbers, with field lengths chosen by the user. This subset 
of the Commercial Subroutine Package includes routines for variable-length decimal 
add (ADD), subtract (SUB), multiply (MPY), divide (DIV), compare (ICOMP), and 
sign test (NSIGN). 

Use of this system eliminates two of the arithmetic problems associated with 
FORTRAN: the accuracy problem (the inexact representation of fractions) and the 
magnitude problem (extended precision values limited to nine digits, etc.). 

• Subroutines for improved speed and control of I/O devices. By taking advantage of 
the 1130' s cycle-stealing capability, the overlapped I/O routines can substantially 
speed the throughput rates of many jobs. Subroutines are supplied for the 

IBM 1442 Card Read Punch 
IBM 1442-5 Card Punch 
IBM 2501 Card Reader 
IBM 1132 Printer 
IBM 1403 Printer 
Console Keyboard 
Console Typewriter 



In addition to input/output, subroutines are supplied for control of the 1132 and 1403 
carriage and the 1442 stacker select mechanism. 

Several utility routines for common tasks: 

NCOMP for comparing two variable-length alphameric (Al) fields 

MOVE for moving data from one area to another 

FILL to fill an area with a specified value 

WHOLE to truncate the fractional portion of a real number 

NZONE for testing and modifying zone punches 
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USE OF THE COMMERCIAL SUBROUTINE PACKAGE 

CSP is modular in design — the user may use whichever routines he needs and ignore the 
others. 

The routines may be assembled on any 4K card 1130 system, but an 8K system will prob- 
ably be required for any extensive usage. The desired subroutines may be inserted in the 
FORTRAN execute deck (card systems) or stored in the Subroutine Library on the disk 
cartridge. In addition, some of the CSP routines use certain parts of the IBM 1130 Sub- 
routine Library. (See "Core Allocation" in the Appendix.) 

All of the routines are written in the 1130 Assembler Language. 
The control statement 

*ONE WORD INTEGERS 
must be used in programs that call any of the Commercial subroutines. 
The control statement 

* EXTENDED PRECISION 

must be used in any program that calls the GET or PUT subprograms. The other CSP 
routines are independent of the real number precision. 

In general, CSP will operate under either Version 1 or Version 2 of the 1130 Disk Monitor 
System. The exceptions are P1403, S1403, P1442, and R2501, which use subroutines 
supplied only with Version 2 (see the detailed descriptions for more particulars). 

The use of the overlapped I/O portion of CSP is an "either/or" proposition. For nondisk 
I/O, the programmer must choose either the CSP overlapped routines or the standard 
FORTRAN routines. The two systems cannot be intermixed within the same program. 
Note the emphasis on nondisk. This exclusion does not apply to disk I/O, which may 
be used regardless which of the two systems is selected. 

Use of the overlapped I/O routines also excludes the employment of the TRACE feature 
of FORTRAN, since it used portions of the FORTRAN package for output. 
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MACHINE REQUIREMENTS 

For execution, an 8K 1130 system, with any card reader, is necessary. In addition, the 
following I/O devices are supported; 

1442 Card Read Punch, Model 6 or 7 

1442 Card Punch, Model 5 

2501 Card Reader, Model Al or A2 

1403 Printer, Model 6 or 7 

1132 Printer 

Console Keyboard 

Console Typewriter 

Other I/O devices may be utilized through standard FORTRAN. 

For assembly, any 1130 card system is sufficient. The subroutines may be card- or 
disk-resident. 



SPECIAL CONSIDERATIONS - ARITHMETIC 

Real arithmetic . When using CSP. remember that the standard FORTRAN limitations 

apply to all real numbers. 

Extended precision numbers should not exceed ±1,000,000,000. (or 9 digits). 

Fractions must be avoided if exact results are desired. All critical arithmetic should be 
done with whole numbers. For example, the extension 

40. 75 hours x $2. 225 per hour 
should be carried out as 

4075. hundredths of hours x 2225. mills per hour 

If this is not done, precision errors may appear in the results. 

n^nud arithmetic. If the nine-digit or fractional limitations ^^^g^^ 
io me the Decimal Arithmetic package may be used. In this system, all arithmetic is 
done ^itii whole numbers (no fractions), and the number of digits in each variable is 
chosen by the user. 

A number in decimal format may be as long as desired; there is no practical limit to 
field length. 
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SPECIAL CONSIDERATIONS - INPUT/OUTPU T 
FORTRAN FORMAT I/O 

Fof r^' °? W01 ? S ^ arrayS in Al format - one alphameric character per word 

IZTl ,T *?* ° Perate ° n ° ther f ° rmats ' inversion routines are supplTed T 
ease the translation between Al and the other format. ^PP^ea to 

In this area, however, one complication may occur: the use of zone punches In manv 
aTeTeTf ^^T'* i- ^^ to X " PUnCh the ™*° *°°^Z ^"re^or neg- 

routine 1 ^^^ORTrIn Z 1 ^^^^ * "" M °°« Btaed by «» COn ™ 
ounS whL nV?i FORTRAN READs, it xs necessary, when keypunching, to omit the 0- 
punch when an 11-punch is present in the same column. This is not a problem with liqo 
produced cards that later serve as input to subsequent runs. No^rSlS^* to 
any positions, will be recognized when the underpunched digit is a zero 'NoTrecogr. zed" 
means that the character position is replaced with a blank. This is the case for botf nput 
and output when standard FORTRAN READs and WRITEs are used. 

^he^ 

When the input routines supplied with this package are used, this problem does not exist 
All zone punches are recognized and are treated properly. * 

CSP OVERLAPPED I/O 

The CSP overlapped I/O routines have been provided to take advantage of the cvcle- 

I/ot Whfd If ** US l B6CaUSe ^ all ° W Pr ° CeSSi ^ to * ™ed before the 
VO is fimshed, their use will increase the throughput rates of many programs. 

The table below summarizes the overlap capabilities of the routines: 



This device 



Card reader (1442 or 2501) 
Card punch 
Console keyboard 
Console printer 
Printer (1132 or 1403) 



is overlapped with this function 



Conversion from card code to Al format 
nothing (not overlapped) 
nothing (not overlapped) 
anything but the console keyboard 
anything 



wt C f P J 7 ? r ° m ^ S alS ° P6rmit ** reading ** Punching of the 11-0 and 12-0 punches 
both of which must be avoided with standard FORTRAN I/O. puncnes, 
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The use of the overlapped I/O portion of CSP is an "either/or" proposition. For nondisk 
I/O, the programmer must choose either the CSP overlapped routines or the standard 
FORTRAN routines. The two systems cannot be intermixed within the same program. 
Note the emphasis on nondisk. This exclusion does not apply to disk I/O, which may be 
used regardless which of the two systems is selected. 

Use of the overlapped I/O routines also excludes the employment of the TRACE feature 
of FORTRAN, since it uses portions of the FORTRAN package for output. 

The following routines are included in the CSP I/O group: 



READ 


PRINT 


TYPER 


PUNCH 


SKIP 


KEYBD 


R2501 


P1403 


STACK 


P1442 


S1403 





If any of these routines are used, standard FORTRAN READ and WRITE commands may 
not appear in the same program. 

When using Version 1 of the 1130 Disk Monitor System, the programmer must place the 
statement 

CALL IOND 

before any STOP or PAUSE statement. This will ensure that all pending I/O interrupts 
have been serviced before the CPU stops or pauses. IOND should not be called if Version 
2 of the Monitor is in use. 

P1403, S1403, P1442, and R2501 use parts of the subroutine library supplied with Version 
2 of the 1130 Disk Monitor System. If they are to be used with a Version 1 Monitor, the 
Version 2 subroutines must be loaded onto the Version 1 disk. See the detailed descrip- 
tions of P1403, S1403, P1442, and R2501 for more particulars. 

DATA FORMATS USED 

Although most of the CSP routines are oriented toward use of the Al format, several new 
formats have been introduced. In addition, several of the standard formats must be con- 
sidered in a different light. 

Al FORMAT 

Al format consists of one character per 16-bit word, left-justified: 



character 


blank 



bits 78 15 
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The right-hand eight bits should always contain the blank character, which is 01000000 in 
binary. This blank will always be inserted by the CSP routines and the standard FORTRAN 
Al format. 

The sign of an Al field is assumed to be carried as an 11- or 12-punch over the rightmost 
character. An 11-punch is taken to signify a negative field; a 12-punch (or no-zone punch) 
signifies a positive field. 

A2 FORMAT 

A2 format consists of two characters per word: 



character 


character 



bits 



7 8 



15 



A3 FORMAT 

Although A3 format exists in standard FORTRAN terminology, its use in this manual has 
a different connotation. Here, A3 format means that one word contains three characters. 

This can be done only by using a unique coding scheme. The user supplies a table of 40 
characters. Then, the A1A3 and A3A1 subroutines may be used to translate from Al to 
A3 format and vice versa. 

The A3 format cannot be pictured graphically, since the three characters are combined 
as a single integer or binary number. 

The A3 format permits highly efficient packing of alphabetic data and may be used to save 
considerable space on the disk. 

Note, however, that only 40 characters may be used. This may not be enough for some 
applications. For example, if the characters chosen were A through Z, through 9, the 
blank, comma, period, and dash, 40 would probably be ample for a name and address 
file. It would not be sufficient for a product description file that also required slashes, 
dollar signs, etc. 

Dl FORMAT 

Dl format consists of one digit per word, right- justified. Because the decimal arithmetic 
routines operate on data in this format, Dl format is also called decimal format. 

Dl format is as follows: 



00000000 



0000 digit 



bits 



7 8 



15 



V decimal field is stored in an array in Dl format. The sign of the field will be carried 
with the rightmost digit. For example, the six-digit field 001968 could be placed in the 
12th through 17th position in the NUMBR array: 

NUMBR (12) = 
NUMBR (13) = 
NUMBR (14) = 1 
NUMBR (15) = 9 
NUMBR (16) = 6 
NUMBR (17) = 8 

The same field, if it were negative, would be written as 001968, and the sign would be 
reflected in the rightmost digit: 

NUMBR (12) = 
NUMBR (13) = 
NUMBR (14) = 1 
NUMBR (15) - 9 
NUMBR (16) = 6 
NUMBR (17)= -9 



Note that NUMBR (17) is -9 rather than -8; this must be done because the 1130 cannot 
represent a negative zero. The following scheme is used with negative numbers; 



If the sign of the field is 

negative and the rightmost The rightmost Dl digit 

digit is a will be carried as a 






-1 


1 


-2 


2 


-3 


3 


-4 


4 


-5 


5 


-6 


6 


-7 


7 


-8 


8 


-9 


9 


-10 



Usually, this need not concern the programmer, since the A1DEC and DECA1 routines 
will automatically implement the special coding of negative fields. Setting up negative 
constants, though, must be handled properly by the programmer. 
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D4 FORMAT 



D4 format consists in general of four decimal digits per word, with each digit occupying 
four bits of the word. However, since the sign digit (the rightmost one) carries the sign, 

it is handled separately, and is placed by itself in the last word of the D4 field. This is 
best illustrated by showing several examples: 



The five-digit 

number 

+ 12345 



first word 



second word 



12 3 4 

0001 0010 0011 0100 



+ 5 



0000 0000 0000 0101 



The six-digit 
number 
+ 123456 



first word 



second word 



0001 0010 0011 0100 



0101 1111 1111 1111 



third word 



+ 6 



0000 0000 0000 0110 



The seven-digit 

number 

+ 1234567 



first word 


second word 


third word 




12 3 4 


5 6 F F 




+ 7 


0001 0010 0011 0100 


0101 0110 1111 1111 


0000 0000 0000 


0111 



The filler consists of four 1 bits, the hexadecimal F. A more detailed description of D4 
format may be found with the description of the DPACK routine. 
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FORMAT REQUIREMENTS 



The requirements for each subroutine are as follows: 








Format of 


Format of 






Format of 


Format of 




Data before 


Data after 






Data before 


Data after 


Subroutine 


Processing 


Processing 




Subroutine 


Processing 


Processing 


ADD 


Dl format 


Dl format 


NSIGN 


Dl format 


Integer 














variable 


A1A3 


Al format 


A3 format 




NZONE 


Al format 


Integer 


A1DEC 


Al format 


Dl format 








variable 


A3A1 


A3 format 


Al format 




PACK 


Al format 


A2 format 


CARRY 


Dl format 


Dl format 




PRINT 


Al format 


Al format 


DECA1 


Dl format 


Al format 




PUNCH 


Al format 


Al format 


DIV 


Dl format 


Dl format 




PUT 


Real variable 
(extended 


Al format 


DPACK 


Dl format 


D4 format 






precision) 




DUNPK 


D4 format 


Dl format 




P1403 


Al format 


Al format 


EDIT 


Al format 


Al format 




P1442 


Al format 


Al format 


FILL 


Any integer 
(Al, A2, Dl, 


Same as 
FILL 




READ 


Al format 


Al format 




etc.) 


character 




R2501 


Al format 


Al format 


GET 


Al format 


Real variable 

(extended 

precision) 




SKIP 
STACK 


, Decimal 
constant 

None 


None 
None 


ICOMP 


Dl format 


Greater than, 














equal to, or 




SUB 


Dl format 


Dl format 






less than zero 










IOND 


None 


None 




S1403 


Decimal 
constant 


None 


KEYBD 


Al format 


Al format 










MOVE 


Any integer 
(Al, A2, Dl, 
etc.) 


Same as 

before 

MOVE 




TYPER 

UNPAC 


Al format 
A2 format 


Al format 
Al format 


MPY 


Dl format 


Dl format 










NCOMP 


Al format 


Greater than* 
equal to, or 
less than zero 


: 


WHOLE 


Real variable 

(any 

precision) 


Real variable 

(any 

precision) 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



DETAILED DESCRIPTIONS 

This section gives the general format and a description of each routine. Each description 
contains format, function, parameter description, detailed description, example, errors, 
and remarks. The function describes the capabilities of the routine. The parameter 
description explains in detail how the parameters, variables, and constants should be set 
up. The detailed description tells exactly what the subroutine does and how it should be 
used. Examples are given as an aid to the programmer. Certain specification and input 
errors may occur when using the package, and these are explained. The remarks section 
describes some peculiarities of the routine. Further information may be obtained from 
the flowcharts and listings. 
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ADD 

Format: CALL ADD(JCABD, J, JLAST, KCARD, K, KLAST, NER) 

Function: Sums two arbitrary-length decimal data fields, placing the result in the 
second data field. 

Parameter description: 

JCARD - The name of a one -dimensional integer array defined in a DIMENSION 

statement. This is the array which is added, the addend. The data must 
be stored in JCARD in decimal format, one digit per word. 



J - 



JLAST 



KCARD - 



K - 



An integer constant, an integer expression, or an integer variable. This 
is the position of the first digit to be added (the left-hand end of a field). 

An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last digit to be 
added (the right-hand end of a field). 

The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the augend, the array which is added to. It will con- 
tain the result in decimal format, one digit per word. 

An integer constant, an integer expression, or an integer variable. This 
is the position of the first digit of KCARD (the left-hand end of a field). 



KLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to K. This is the position of the last character of 
KCARD (the right-hand end of a field). 

NER - An integer variable. Upon completion of the subroutine, this variable 
indicates whether arithmetic overflow occurred. 

D etailed description : The corresponding digits, by place value, of JCARD and KCARD, 
are summed and placed back in KCARD. This operation is from left to right, with both 
fields being right-adjusted. Next, all carries are set in order. If overflow occurred, 
it is indicated by NER being equal to KLAST. NER must be initialized and reset by the 
user More detailed information may be found in the ADD flowchart and listing. 



ADD 
A1A3 
A1DEC 
A3A1 
CARRY 
DECA1 
DIV 
DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 
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Example: DIMENSION IGRND(12),ITEM(6) 
N=0 
CALL ADD(ITEM, 1, 6, IGRND, 1, 12, N) 



Before: 



IGRND 000713665203 



Position 1 5 10 
N=0 



ITEM 102342 



■ 



Position 1 5 



After: 



IGRND 000713767545 



• 



ITEM is unchanged. 



Position 1 5 10 
N=0 



The numeric data field ITEM, in decimal format, is ADDed to 
the numeric data field IGRND, also in decimal format. Note 
that the fields are both right-justified. The error indicator, 
N, is the same, since there is no overflow out of the high-order 
digit (left-hand end) of the IGRND field. 



Errors: If the KCARD field is not large enough to contain the sum, that is, if there 1H , 

srs^as^r-rr indicator * ner ' wm be set -- ™. 



is a 



If the JCARD field is longer than the KCARD field, nothing will be done and the error in- 
dicator will be equal to KLAST. 

R|niarks: Conversion from EBCDIC to decimal is necessary before using this subroutine 
This may be accomplished with the A1DEC subroutine. suoroutine. 

avlVablf ° f ** JCARD ^ KCARD fi6ldS is arbitrar ?' ** to «* ^imum space 

Note that the error indicator is not reset by this subroutine. It is the responsibilitv of the 
user to initialise, test, and reset the error indicator. ponsimnty ot the 
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A1A3 

Format: CALL A1A3(JCARD, J, JLAST,KCARD,K,ICHAR) 

Function: To convert from Al format (one character per word) to A3 format (three 
characters per word). 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the field to be converted. Originally, 
this field must be in Al format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be converted (the left- 
hand end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable. This 
is the position of the last character of JCARD to be converted (the right- 
hand end of a field) . 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the array into which the data is converted, in A3 
format, three characters per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of KCARD to receive the converted 
characters (the left-hand end of a field). 

ICHAR - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains a table used in the conversion. 

Detailed description : Three characters in Al format are taken, one at a time, from the 
JCARD array. The relative position of each character is found in the table ICHAR. 
Then these three relative positions are used to form an A3 integer as follows: 

A3 INTEGER=(Nl-20)* 1600+(N2*40)+N3 

where Nl is the relative position of the first character in the ICHAR array, etc. The 
A3 integer is then placed in the KCARD array, and the next group of three Al characters 
is packed, and so on. Note that the relative position runs from to 39, not 1 to 40. 



ADD 
• A1A3 
A1DEC 
A3A1 
CARRY 
DECA1 
DIV 
DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 
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Example: 



Setup ICHAR as follows: 



DIMENSION ICHAR(40) 
READ(2,1) ICHAR 
FORMAT (40A1) 



or 



DIMENSION ICHAR(40) 
CALL READ(ICHAR, 1,40,N) 

The card to be read is: 



Content 



Card column 
Relative position 



ETAOINbSHRDLUCMFWYP0123456789VBGKQ JXZ , . & 

t i i t t t * t t 

1 5 10 15 20 25 30 35 40 



9 



14 



19 24 29 



34 



39 



It is the user's responsibility to create the ICHAR array. It must always contain 
40 characters. 

A1A3 may be used as follows: 

DIMENSION JCARD(21) , KCARD(IO) ,ICHAR(40) 
CALL A1A3(JCARD, 1,21, KCABD, 1, ICHAR) 



Before: 



JCARD 
Position 
KCARD 
Position 



CUSTOMER NAME IS HERE 

t t t t t 

15 20 



10 



0123456789 

t t t 

1 5 10 



ICHAR is as above. 



After: 

KCARD 
Position 



JCARD is the same. 
ICHAR is the same. 
-10713 -30266 -31634 -23906 -31756 -20552 -31640 7 8 9 

1 2 3 4 5 6 789 10 



Represents CUS TOM ER6 NAM E6I S6H ERE 

The large negative numbers at each of the first seven positions reflect A3 integers 

(three Al characters). I 
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Errors: If a character does not appear in ICHAR, and does appear in JCARD, it will be 
coded as a blank. 

Remarks : It is the user's responsibility to create the ICHAR array. It must always 
contain 40 characters. The arrangement shown in the example is, in general, the best, 
since the characters appear in the order of their most frequent occurrence, and this 
arrangement includes those characters (A-Z, 0-9, blank, comma, period, and ampersand) 
commonly found in alphabetic files (names and addresses, etc.). The user may, however, 
place any 40 characters in the ICHAR array, in any order. 

If the field to be compressed consists primarily of numbers, for example, they should be 
placed first in the ICHAR array. 

Note that the A3 format discussed here is a special one and is not the same as the 
FORTRAN A3 format. 



-17- 



ADD 

A1A3 

A1DEC- 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 
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A1DEC 



- Format : CALL A1DEC(JCARD,J,JLAST,NER) 

Function: Converts a field from Al format, one digit per word, to decimal format, 
right-justified, one digit per word. 

Parameter des cription: 

JCARD - The name of a one -dimensional integer array defined in a DIMENSION 
statement. This is the name of the field that will be converted. Orig- 
inally, this field must be in Al format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be converted (the left- 
hand end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be converted (the right-hand end of a field). 

NER - An integer variable. This variable will be equal to the position of the 

last invalid (nonnumeric or nonblank) character encountered, except for 
the JLAST position, which may contain a sign. 

Detailed description: The subroutine operates from left to right. Each character is 
checked for validity (digit or blank) . Blanks are changed to zeros. If a character is 
invalid, the error indicator, NER, is set equal to the position of the character. If the 
character is valid, it is converted to decimal format and right -justified using the for- 
mula 

Decimal digit = (character + 40 32)/25 6 

When all characters have been converted, the decimal field is signed. More detailed 
information may be found in the A1DEC flowchart and listing. 
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Example: DIMENSION IFLD(20) 

N=0 
CALL A1DEC(IFLD,7,17,N) 



Before: 



IFLD 



Position 



7,17 



AbBbCbDbEbFbbbbbbbbb0b7blb3b6b6bJbEbNbDb 



10 



15 



20 



N=0 



After: 



7,17 

A- 



IFLD AbBbCbDbEbFb00000713661EbNbDb 



Position 



10 15 



20 



N=0 



Before execution, the field is shown in Al format, the character followed by a blank. 
Therefore, the field to be converted is 

bbbb071366J 

After execution, the field has been converted, as is evident. There were no invalid 
characters in the field, since N is the same. 

Errors: K an invalid character (nonnumeric or nonblank) is encountered, the error 
indicator is set equal to the position of that character, and processing of the field 
continues. 

Remarks: When the error indicator has been set, the character indicated is the last 
invalid character. There may be' other invalid characters in the field, occurring to 
the left of the character noted. 
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Zone punches are used, at times, to indicate conditions (switches). These zones can be 
removed with the NZONE subroutine. Following is an error routine to correct errors 
of this type: 



Main Line 



CALL A1DEC(IFLD,J,JLAST,N) 
IF(N) 2,2,3 
Continue Main Line 



3 Error Routine 

CALL NZONE(IFLD,N,4,Nl) 

N1=0 

CALL A1DEC(IFLD,N,N,N1) 

IF(N1) 5,5,4 

4 STOP 999 

5 CALL DECA1(IFLD,J,JLAST,N) 
N=0 

GO TO 1 

When an error of this type occurs, N will be greater than zero. Control would go to 
statement 3. Using the NZONE routine, the zone is removed (if not a special character). 
The invalid character is now converted with the A1DEC routine. If the character is still' 
invalid, control goes to statement 4 and the program will STOP. If the character is now 
valid, it has been converted and control goes to statement 5. However, there may have 
been other invalid characters. Therefore, at statement 5 the field is converted back to 
Al format and control returns to statement 1, where the field is again converted from 
Al format to decimal format. This process continues until a truly invalid character 
(special character) is encountered, or until the field is converted with no errors. 

Note that the error indicator is not reset by this subroutine. It is the responsibility 
of the user to initialize and reset the error indicator. 
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A3A1 

Format : 

Function: 



CALL A3A1(JC ARD, J, JLAST, KCARD, K, ICHAR) 

To convert from A3 format (three characters per word) as created by the 
A1A3 subroutine to Al format (one character per word). 



Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the field to be converted. Originally, 
this field must be in A3 format, three characters per word. 

J - An integer constant, an integer expression, or an integer variable. 

This is the position of the first element of JCARD to be converted (the 
left-hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable. 

This is the position of the last element of JCARD to be converted (the 
right-hand end of a field) . 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the array into which the data is converted, in Al 
format, one character per word. 

K - An integer constant, an integer expression, or an integer variable. 

This is the position of the first element of KCARD to receive the con- 
verted characters (the left-hand end of a field). 

ICHAR - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains a table used in the conversion. 

Detailed description : A3 integers are taken, one at a time, from the JCARD array. Each 
is decoded Into the three numbers of which it is composed, as follows: 



Nl= 



( (A3 INTEGER/1600) + 20 if the A3 integer is positive 



\ ((A3 INTEGER + 32000)/1600) if the A3 integer is negative j 

N2=(A3 INTEGER-(Nl-20)*1600)/40 

N3=A3INTEGER-(N1-20)*1600-(N2*40) 

The resulting integers, Nl, N2, N3, are then used to locate their corresponding Al 
characters in the ICHAR array. Each Al character is then placed in the KCARD array. 

Note that each element of JCARD requires three elements in KCARD. 
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Example: 



Content 

Card 
column 

Relative 
position 



Set up ICHAR as follows: 

DIMENSION ICHAR(40) 

READ(2, 1) ICHAR 
1 FORMAT (40A1) 

or 

DIMENSION ICHAR(40) 
CALL READ(ICHAR, 1, 40, N) 

The card to be read is: 
ETAOINbSHRDLUCMFWYP0123456789VBGKQJXZ, . & 

t ft f t t I i 

1 5 10 15 20 25 30 35 40 







9 



14 



19 24 29 



34 



39 



It is the user's responsibility to create the ICHAR array. It must always contain 40 
characters. 

A3A1 may be used as follows: 

DIMENSION JCARD(21), KCARD(30), ICHAR(40) 

CALL A3A1(JCARD,1,8, KCARD, 1, ICHAR) 



Before: 



JCARD -30076 -20556 -20547 -26800 -15765 -23397 -17038 -30237 
Position 



1 



I 

5 



KCARD 012345678901234567890123456789 

t t t t t t t 

Position 15 10 15 20 25 30 
ICHAR is as above. 



After: 



JCARD is the same. 
ICHAR is the same. 
KCARD THIS IS CODED INFORMATI0456789 

t t t t t t t 

Position 15 10 15 20 25 30 
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Errors: If JLAST is less than J, one element will be decoded into three characters. 

Remarks : It is the user' s responsibility to create the ICHAR array. It must always con- 
tain 40 characters. The arrangement shown in the example is, in general, the best, 
since it is in the order of the most frequent occurrence of the letters of the alphabet. 

Note that the A3 format discussed here is a special one, and is not the same as the 
FORTRAN A3 format. 



-23- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY- 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



CARRY 

Format ; CALL CARRY( JCARD, J , JLAST , KARRY) 

- Function : Resolve all carries within the specified field and indicate any high-order 

carry out of the field. This routine will not normally be called by the us er. 

Parameter description: 



JCARD - 



J - 



JLAST 



The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the field that will be interrogated for carries. The 
data must be in decimal format. 

An integer constant, an integer expression, or an integer variable. 
This is the position of the first digit of JCARD (the left-hand end of a 
field). 

An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last character 
of JCARD (the right-hand end of a field) . 



KARRY - An integer variable. This variable will contain any carry out of the 
high-order position of the JCARD field. If there is no carry, KARRY 
will be set to zero. 

Detailed description : The routine operates from right to left, examining the low-order 
digit first. The digit being examined is divided by ten. Since only integers are used, 
the quotient of this division is the carry in that digit. Ten times the carry is subtracted 
from the digit. If the digit is now negative, ten is added to the digit and one is sub- 
tracted from the carry. At this point, or if the resultant digit was positive, the next 
digit to the left is examined. First, the carry from the previous digit is added to this 
digit. Then the process for the first digit, starting with division by ten, is carried out. 
When all digits have been examined, from JCARD(JLAST) to JCARD(J) inclusive, the 
final carry is set and the routine terminates. More detailed information may be found 
in the CARRY flowchart and listing. 
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Example: DIMENSION NUMB(IO) 

CALL CARRY(NUMB,1,10,N) 



Before: 



NUMB 00 72 6 27 51811 



Ittlttlt 



Position 12 34 56789 10 

N=22 



After: 



NUMB 0723350211 

it 1 1 



Position 



10 



N=0 



After an arithmetic operation the condition of the NUMB field is as shown at "Before". 
The third, fifth and eighth positions appear as shown, because multiple arithmetic 
operations have generated them. The object of the CARRY routine is to resolve this 
type of problem. 

Notice that a 1 has been borrowed from the seventh position to resolve the -8 condition. 
Similarly, a 3 has been borrowed from the fourth position, and the 7 from 72 has gone 
into the second position. 

Errors : None 

Remarks : This routine is used by the other routines in this package as a service routine. 
In general, the user need not call this routine, since all carries are resolved by the 
arithmetic routines themselves (ADD, SUB, MPY, DIV). 
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DECA1 

Format : CALL DECA1( JCARD, J, JLAST, NER) 

Function : Converts a field from decimal format, right-justified, one digit per word, to 
Al format, one character per word. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the name of the field that will be converted. Origi- 
nally, this field must be in decimal format, one digit per word. 

J - An integer constant, an integer expression, or an integer variable. 
This is the position of the first digit of JCARD to be converted (the 
left-hand end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last character 
of JCARD to be converted (the right-hand end of a field). 

NER - An integer variable. This variable will be equal to the position of the 

last digit of JCARD which was negative or greater than 9, except for the 
JLAST position, which can be negative (sign). 

Detailed description : The subroutine operates from left to right. First the sign is de- 
termined. Then each digit, starting with JCARD(J), is converted to Al format using the 
formula 

Character = 256 * (decimal digit) - 4032 

When all digits have been converted, the field is signed. More detailed information 
may be found in the DECA1 flowchart and listing. 
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Example: DIMENSION IFLD(20) 

N=0 
CALL DECA1(IFLD,7,17,N) 



Before: 
IFLD 



7,17 
,a 



AbBbCbDbEbFb'00000713661EbNbDb 



Position 1 

N=0 



10 15 



20 



After: 



7,17 



IFLD AbBbCbDbEbFb r 0b0b0b0b0b7blb3b6b6bJb'EbNbDb 



Position 1 

N=0 



10 



15 



20 



Before execution the field is shown in decimal format. The field to be converted is 

00000713661 

After execution, the field has been converted to Al format, as is evident, the character 
followed by a blank. There were no invalid digits in the field, since N is the same. 

Errors : If an invalid digit (not to 9, inclusive) is encountered, the error indicator is 
set equal to the position of that character, and processing of the field continues. 

Remarks : When the error indicator indicates an error, the digit indicated is the last 
invalid digit. There may be other invalid digits in the field, occurring to the left of the 
digit noted. 

These errors should not occur, since the arithmetic routines (ADD, SUB, MPY, and 
DIV) will resolve carries. However, if this does happen, the user's program should 
indicate (possibly by STOPing) that this has occurred. 

Note that the error indicator is not reset by this subroutine. It is the responsibility of 
the user to initialize and reset the error indicator. 
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DIV 

Format : CALL DIV(JCARD,J,JLAST,KCARD,K,KLAST,NER) 

Function : Divides one arbitrary-length decimal data field by another, placing the 
quotient and remainder in the dividend. 

- Parameter description : 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array is the divisor. The data must be stored in 
JCARD in decimal format, one digit per word. 

J - An integer constant, an integer expression, or an integer variable. 
This is the position of the first digit of the divisor (the left-hand end of 
a field) . 

JLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last digit of the 
divisor (the right-hand end of a field) . 

KCARD- The name of a one -dimensional integer array defined in a DIMENSION 
statement. This array, the dividend, will contain the quotient and the 
remainder, extended to the left, in decimal format, one digit per word. 

K - An integer constant, an integer expression, or an integer variable. 
This is the position of the first digit of the dividend (the left-hand end 
of a field). 

KLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to K. This is the position of the last digit of 
the dividend (the right-hand end of a field) . This is also the position 
of the last digit of the remainder . 

NER - An integer variable. Upon completion of the subroutine, this variable 
indicates whether division by zero was attempted, or whether the 
KCARD field is not long enough. 

Detailed description : First the signs are cleared from both fields and saved. Then the 
KCARD field is extended to the left the length of the JCARD field (JLAST-J+1), and 
filled with zeros. If the KCARD field will be extended below KCARD(l), NER will be set 
equal to KLAST and the routine will be terminated. Next, the JCARD field is scanned to 
find the high-order significant digit. If no digit is found, the error indicator NER is set 
to KLAST, and the result is the same as the input. When a digit is found, the division 
begins. It is done by the method of trial divisors: 

1. The high-order digit of the divisor is used as the trial divisor. 

2. The trial divisor is divided into the next high-order digit of the dividend to generate 
a digit of the quotient. 

3. The digit of the quotient is multiplied by the trial divisor. 

4. This product is subtracted from the corresponding number of digits in the high- 
order portion of the dividend. 
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5. As long as the result is positive, the quotient digit is the next digit in the quotient. 
A return is made to step 2. 

6. When the result is negative, the product from step 3 is added back to the dividend, 
1 is subtracted from the quotient digit, and the new quotient digit is placed in the 
quotient as the next digit. Finally, the signs are generated for the quotient and 
remainder and the sign is replaced on the divisor. 

The quotient will be located in the KCARD field. The subscript of the first digit of the 
quotient will be K-(JLAST-J+1) , and the subscript of the last digit of the quotient will be 
KLAST-(JLAST-J+1) . 

The remainder will also be located in the KCARD field. The subscript of the first digit 
of the remainder will be KLAST-JLAST+J, and the subscript of the last digit of the re- 
mainder will be KLAST. 



KCARD 



QUOTIENT 



K B 



REMAINDER 



t t t t 



D 



A is the position whose subscript is K-(JLAST-J+1). 
K is the first position of the dividend, defined earlier. 
B is the position whose subscript is KLAST-(JLAST-J+1). 
C is the position whose subscript is KLAST-(JLAST-J). 
D is the position whose subscript is KLAST. 

More detailed information may be found in the DIV flowchart and listing. 



Example: DIMENSION IDVSR(5),IDVND(15) 

N=0 
CALL DIV(IDVSR,1,5,IDVND,6,15,N) 



Before: 
IDVSR 

Position 

N=0 



00982 

t t 

1 5 



IDVND ABCDE0007136673 



till 



Position 1 5 10 15 



After: 

IDVSR is unchanged. 
N=0 



IDVND 000000726700479 



Position 15 10 15 
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The numeric data field IDVND has been divided by the numeric data field IDVSR, the 
quotient and remainder being placed in IDVND. Note that the IDVND field has been 
extended to the left the length of the IDVSR field, five positions. 

Errors : If division by zero is attempted, the only action is that KCARD is extended and 
filled with zeros. The error indicator indicates that division by zero was attempted 
(NER=KLAST). 

If there is not enough room to extend the KCARD field to the left, NER will again be set 
equal to KLAST, and the routine will terminate. None of the fields involved will be 
modified. 

Remarks : Conversion from EBCDIC to decimal is necessary before using this subroutine. 
This may be accomplished with the A1DEC subroutine. 

The length of the JCARD and KCARD fields is arbitrary, up to the maximum space 
available. 

The arithmetic performed is decimal arithmetic, using whole numbers only. No decimal 
point alignment is allowed. For this reason numbers should have an assumed decimal 
point at the right-hand end. 

Space must always be provided in the KCARD field for expansion. The first position of 
the dividend, K, must be at least JLAST-J+1 positions from the beginning of KCARD, 
For example, if JCARD is seven positions, 1 through 7, the dividend in KCARD must 
start at least seven positions (7-1+1=7) from the beginning of KCARD. This would have 
K equal to 8. 
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DPACK 

Format: CALL DPACK(JCARD, J, JLAST, KCARD, K) 

Function: Information in Dl format, one digit per word, is packed into D4 format, four 
digits per word. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This array contains the data to be packed, in Dl format, one 
digit per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be packed (the left-hand 
end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable greater 
than J. This is the position of the last character of JCARD to be packed 
(the right-hand end of a field). 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This is the array into which the data is packed, in D4 format, 
four digits per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of KCARD to receive the packed char- 
acters (the left-hand end of a field). 

Detailed description: Initially, the field to be packed (the JCARD array) is in Dl format. 
This consists of one digit per word, right-justified (occupying the rightmost four bits of 
the word). The sign of the field is carried with the rightmost or low-order digit. 

The operation of the DPACK subroutine is as follows: Starting at JCARD(J), and working 
from left to right, each four-bit digit of the JCARD array is placed into four bits of the 
KCARD array, four to the word, starting at KCARD(K). When JCARD(JLAST) is en- 
countered, it is assumed to be the last Dl digit, and to carry the sign of the field. The 
DPACK routine then places JCARD(JLAST), unpacked, in its entirety, into 
KCARD((JLAST-J+7)/4), the last position in the KCARD array. 
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Any unused space in the preceding KCARD word is then filled with 1 bits, 
arrangement or format will be called D4 format. 



This bit 



For example, suppose a seven-position JCARD array is to be packed, and it contains 1, 
2, 3, 4, 5, 6, 7: 



JCARD(l) 
JCARD(2) 
JCARD(3) 
JCARD(4) 



1 
2 
3 
4 
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JCARD(5) = 5 
JCARD(6) = 6 
JCARD(7) = 7 

JCARD(l) through JCARD(4) will be placed in KCARD(l) as 0001 0010 0011 0100. 

JCARD(5) and JCARD(6) will be placed in KCARD(2) as 0101 0110 0000 0000. 

JCARD(7) will be placed, without conversion, in KCARD(3) as 0000 0000 0000 0111. 

Then the two unused four-bit areas in KCARD(2) will be filled with l's as 0101 OHO 
1111 1111. 

More detailed information may be found in the DPACK/DUNPK flowchart and listing. 

The table below may be used to determine the number of words required for a field after 
it is packed. For example, a twelve-digit decimal field will be packed into a four-word 
field: 

• First word: 1st, 2nd, 3rd, and 4th digits 

• Second word: 5th, 6th, 7th and 8th digits 

• Third word: 9th, 10th, and 11th digits, plus four 1 bits (filler) 

• Fourth word: 12th digit carrying the sign of the field. 



Field Length 


Field Length 


Field Length 


Before 
Packing 


After 
Packing 


Before 
Packing 


After 
Packing 


Before 
Packing 


After 
Packing 


2 
3 
4 
5 


2 
2 
2 
2 


18 
19 
20 
21 


6 
6 
6 
6 


34 
35 
36 
37 


10 
10 
10 
10 


6 

7 
8 
9 


3 
3 
3 
3 


22 
23 
24 
25 


7 
7 
7 
7 


38 
39 
40 
41 


11 
11 
11 
11 


10 
11 
12 
13 


4 
4 
4 
4 


26 

27 
28 
29 


8 
8 
8 
8 


42 
43 
44 
45 


12 
12 

12 
12 


14 
15 
16 
17 


5 
5 
5 

5 


30 
31 
32 
33 


9 
9 
9 
9 


46 
47 
48 
49 


13 
13 
13 
13 
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Example: 



DIMENSION IUNPK(26),IPAKD(26) 
CALL DPAGK(IUNPK, 1, 10,IPAKD, 1) 



Before: 

IUNPK 123456789123 



>> 



Position 



1 5 10 



IPAKD ABCDEFGHIJ 

A 



Position 



10 



After: 

IUNPK is the same. 

IPAKD 1234 5678 9FFF 0001 EFGHIJ 

TT t t ttt 



1 2 



4 5 6 10 



Position 



Errors: None 

Remarks: If JLAST is less than or equal to J, only one character of JCARD will be 
packed, and it will be treated as the sign. A multiple of four characters in JCARD will 
always be packed into KCARD. An equation for how much space is required, in ele- 
ments, in KCARD is : 



Space in KCARD = 



JLAST-J+7 



This result is rounded down at all times. 
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DUNPK 

Format: CALL DUNPK(JCARD, J, JLAST, KC ARD, K) 

Function: Information in D4 format, four digits per word, is unpacked into Dl format, 
one digit per word. 

Parameter description: 



JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the data to be unpacked, in D4 format, 
four digits per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of JCARD to be unpacked (the left-hand 
end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable greater 
than J. This is the position of the last element of JCARD to be unpacked, 
(the right-hand end of a field). 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This is the array into which the data is unpacked, in Dl for- 
mat, one digit per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of KCARD to receive the unpacked 
characters (the left-hand end of a field). 

Detailed description: See the detailed description of DPACK for an explanation of the Dl 
and D4 formats. 

The JCARD field, in packed (D4) format, will be unpacked (converted to Dl format) and 
placed in the KCARD field. Starting at JCARD(J), moving from left to right, each four- 
bit digit is placed in the rightmost four bits of a word in the KCARD array, starting at 
KCARD(K). 

Filler bits (four l's) are recognized as such and are ignored. 

JCARD(JLAST), the last word to be converted, is not altered, but is moved to ' 
KCARD(KLAST). KLAST cannot be calculated exactly at this point, but KLAST-K+1 
will be the same as JLAST-J+1 when the field was originally packed. In other words, 
field lengths will not be changed by a DPACK and subsequent DUNPK. 

The maximum value of KLAST can be calculated as 

4*(JLAST-J)+1 

However, it may be one, two, or three fewer positions in length. 
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More detailed information may be found in the DPACK/DUNPK flowchart and listing. 



Example: 



DIMENSION IUNPK(26),IPAKD(26) 
CALL DUNPKflPAKD, 1,3, IUNPK, 1) 



Before: 



IPAKD 1234 5678 0003 



IUNPK FblbLbLbbblbNbbbTbHblbSb 



t t t 

1 2 3 



Position 



Position 1 



10 



After: 



IPAKD is the same. 



IUNPK 123456783HbIbSb 



Position 1 5 10 



Errors: None 

Remarks: If JLAST is less than or equal to J, only the first element of JCARD, JCARD(J) 
will be unpacked and it will be treated as the sign. 
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EDIT 

Format: CALL EDIT(JCARD, J, JLAST, KCARD, K, KLAST) 

Function; Edits data from one array into another array, which contains the edit mask. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the data to be edited, called the source 
field, one character per word, in Al format. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be edited (the left-hand 
end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, greater 
than or equal to J. This is the position of the last character of JCARD to 
be edited (the right-hand end of a field). 

KCARD - The name of a one -dimensional integer array defined in a DIMENSION 

statement. This is the array into which data is edited; it contains the edit 
mask before editing begins, stored one character per word, in Al format, 
and is called the mask field. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of the edit mask (the left-hand end of 
a field). 

KLAST - An integer constant, an integer expression, or an integer variable, greater 
than K. This is the position of the last character of the edit mask (the 
right-hand end of a field). 

Detailed description: The following table gives the control characters for editing, the 
characters used to make up the mask, and their respective functions: 

Control Character Function 



b (blank) 
(zero) 



This character is replaced by a character from the 
source field. 

This character indicates zero suppression and is replaced 
by a character from the source field. The position of this 
character indicates the rightmost limit of zero suppres- 
sion (see description of operation below). Blanks are 
inserted in the high-order nonsignificant positions of 
the field. 
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Control Character 
. (decimal point) 

, (comma) 



CR (credit) 



- (minus) 
* (asterisk) 



$ (floating dollar 
sign) 



Function 

This character remains in the mask field where placed. How- 
ever, if zero suppression is requested, it will be removed if 
it is to the left of the last character to be zero-suppressed. 

This character remains in the mask field where placed. 
However, if zero suppression is requested, it will be 
removed if it is to the left of the last character to be 
zero-suppressed. 

These two characters can be placed in the two rightmost 
positions of the mask field. They are undisturbed if the 
source field is negative. (If the source field is positive, 
the characters C and R are blanked out. ) In editing 
operations, a negative source field is indicated by an 
11-zone over the rightmost character. Whether CR is 
blanked out or not, no data will be edited into these 
positions when CR is present, but rather into the edit 
characters to the left. 

The letters C and R may be used in the remainder of 
the edit mask, where they will be treated as normal 
alphabetic characters, without being subject to sign 
control. 

Only the R character is checked, so the C character may 
be any legal character, and it will be treated as 
described. 

This character is handled similarly to CR in the 
rightmost position of the mask field. 

This character operates the same as the (zero) for 
zero suppression, except that asterisks rather than 
blanks are inserted in the high-order nonsignificant 
positions of the field, providing asterisk check 
protection. 

This character has the same effect as the (zero) for 
zero suppression, except that a $ is inserted to the left 
of the first significant character found, or to the left 
of the position that stopped the zero suppression. 



The operation of the edit routine may be described in five steps: 

1. Characters are placed in the mask field from the source field, moving from right 
to left. The characters (zero), b (blank), * (asterisk) and $ (dollar sign) are re- 
placed with characters from the source field. No other characters in the mask 
field are disturbed. 
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2. If all characters in the source field have not been placed in the mask field before the 
end of the mask field is encountered, the whole mask is set to asterisks and editing 
is terminated. 

3. CR (credit) and - (minus) in the rightmost positions of the mask field are blanked if 
the source field is positive (does not have an 11-zone over the rightmost character). 

4. The zero suppression scan starts at the left end of the mask field and proceeds left 
to right, replacing zeros (0), blanks (b's), decimal points (.), and commas (,). The 
last position replaced will occur where the zero suppression character was located, 
or one position to the left of where a significant character, not zero (0), blank (b), 
decimal point (. ), or comma (,), occurs. If the zero suppression character was an 
asterisk (*), the replacement character is an asterisk. Otherwise, the replacement 
character is a b (blank). 

5. If the zero suppression character was a dollar sign ($), a dollar sign is placed in the 
last replaced position in the zero suppression scan. 

In order for the edit routine to work correctly and as described, five rules must be 
followed in creating the mask field: 

1. There must be at least as many b's (blanks) in the mask field as characters in the 
source field. 

2. If the mask field contains zero (0), asterisk (*), or dollar sign ($), zero suppression 
will be used and the first character in the mask field must be a b (blank). 

3. The mask field must not contain more than one of the following, which may appear 
only once: 

(zero) 
* (asterisk) 
$ (dollar sign) 

4. If the rightmost character in the mask field is an R, the next character to the left 
should be a C, in order to edit with CR (credit). Both characters will be blanked if 

the source field is positive. If the rightmost character in the mask field is - (minus), 
it will be blanked if the source field is positive. 

5. All numeric, alphabetic, and special characters may be used in the mask field. All 
characters that do not have special meaning will be left in their original position in 
the mask field during the edit. 

More detailed information may be found in the EDIT flowchart and listing. 
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Example ; There are three common methods for creating a mask field such as b,bb$.bbCR: 



Method 1 



DIMENSION MASK(IO) 
1 FORMAT(lOAl) 
IN=2 
READ(IN, 1)MASK 



Method 3 



Method 2 



DIMENSION MASK(IO) 

MASK(1)=16448 

MASK(2)=27456 

MASK(3)=16448 

MASK(4)=16448 

MASK(5)=23360 

MASK(6)=19264 

MASK(7)=16448 

MASK(8)=16448 

MASK(9)=-15552 

MASK(10)=-9920 



DIMENSION MASK(IO) 
DATA MASK/'b', ', ', 'b«, 'b', '$', '. ', 'b', 'b', 'C», 'R'/ 



Method 1 creates the mask by reading it from a card. Method 2 creates the mask with 
FORTRAN arithmetic statements, setting each position of the mask to the desired char- 
acter. It uses the decimal equivalents of the various EBCDIC codes, as listed in the 
APPENDDI. Method 3, using the DATA statement, is by far the shortest and simplest. 
Note that each character requires a word of core storage, regardless of the method 
employed. 
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The table of examples below illustrates how the EDIT routine works: 



Source Field 

00123D 

00123M 

00123M 

00123D 

46426723 

00200P 

082267139 

01234567 

0AB1234 

-12345 



Mask Field 
bb,bb$.bbCR 
bb,bb$.bbCR 
bb,bb$.bb- 
bb,bb$.bb- 
b,bbb,bb$.bbCR 
b,bb*.bbCR 
bbb-bb-bbbb 
bbbb$.bbCR 
bbbbb$.bbCR 
bb,bb$.bb- 



Result 



bbb$12. 34bb 
bbb$12. 34CR 
bbb$12„ 34- 
bbb$12.34b 
b$464,267.23bb 
***20, 07CR 
082-26-7139 

b$AB12.34bb 
$-.123. 45b 



Because the mask field is destroyed after each use, it is advisable to move the mask 
field to the output area and perform the edit function in the output area. 

Errors: If the number of characters in the source field is greater than the number of 
blanks in the mask field, the mask field is filled with asterisks(*). 
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FILL 

Format : CALL FILL(JCARD,J,JLAST,NCH) 

Function : Fills an area with a specified character. 

Parameter description : 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the area to be filled. 

J - An integer constant, an integer expression, or an integer variable. 
This is the position of the first character of JCARD to be filled (the 
left-hand end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be filled (the right-hand end of a field). 

NCH - An integer constant, an integer expression, or an integer variable. This 
is the code for the fill character. The Appendix contains a list of those 
codes corresponding to the EBCDIC character set; however, NCH may 
be any integer. 

Detailed description: The area of JCARD, starting with J and ending with JLAST, is 
filled with the character equivalent to the NCH code, one character per word. More 
detailed information may be found in the FILL flowchart and listing. 



Example: CALL FILL (IPRNT ,3,10,16448) 

Fill the area IPRNT from positions 3 through 10 with blanks. In other words, clear the 
area. 



IPRNT: 



Before: ABCDEFGHIJKLMNOPQRSb 



After: ABbbbbbbbbKLMNOPQRSb 



Position 1 



10 



15 



20 
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Errors: None. 
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GET 

Format : GET (JCARD, J, JLAST, SHIFT) 

Function: Extracts a data field from an array, and converts it to a real number. This 
is a function subprogram. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the data to be retrieved, stored one 
digit per word, in Al format. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be retrieved (the left- 
hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable t 

greater than or equal to J. This is the position of the last character of 
JCARD to be retrieved (the right-hand end of a field). 

SHIFT - A real constant, a real expression, or a real variable. If decimal places 
are required, SHIFT is equal to 10"^, d being the number of decimal 
places. When SHIFT is used as a scale factor, SHIFT is 10^, d being the 
number of zeros. If a card contains 12345 and the value of SHIFT is 
0. 0001, the result will be 1. 2345. The result will be 123450. if a value 
10. is assigned to SHIFT. 

Detailed description: Using the formula 

BINARY DIGIT = (EBCDIC CODE + 4032) / 256 

the real digits are retrieved. Each binary digit is shifted left and summed, resulting in 
a whole number decimal. The sum is multiplied by SHIFT to locate the decimal point. 
The result is then placed in the real variable GET. If there are blanks in the data field, 
they are treated as zeros. If a nonnumeric character, other than blank, appears in any 
position other than the low-order position, the variable containing the result is zero. 
If a special character, other than the - (minus), appears in the low-order position, the 
resulting variable is set to zero. 

For input and for output the sign must be placed over the low-order position as an 
11-punch for minus and a 12 or no overpunch for plus. If the low-order position is zero 
and the number is negative, the column must contain only an 11-punch. (The zero must 
not be punched when FORTRAN I/O is used. ) If the low-order position is zero and the 
number is positive, the column must contain only the zero punch. (The 12 row must not 
be punched when FORTRAN I/O is used. ) 

More detailed information may be found in the GET flowchart and listing. 
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Example 1: DIMENSION INCRD(80) 

B=GET(INCRD,1,5,0. 001) 



Before: 



INCRD 



0123456b. 



Position 1 



B = 0.0 



After: 



INCRD is the same. 



B - 1. 234 (Approximately, since a fraction is present) 



Example 2: 






A 


= 


GET (INCRD, 1,6, 1.0) + GET (INCRD, 7, 12,1. 0) 




+ 


GET (INCRD, 13, 18, 1.0) + GET (INCRD, 19,24, 1. 0) 




+ 


GET (INCRD, 25, 30, 1.0) + GET (INCRD, 31,36, 1. 0) 




+ 


GET (INCRD, 37, 42, 1.0) + GET (INCRD, 43,48, 1. 0) 


Before: 






INCRD 
Position 




001221 000070 145035 700357 161111 724368 120001 270124 

t t 1 1 I t t t t 

16 12 18 24 30 36 42 48 


A=0.0 






After: 




INCRD is the same 

A = 2122287. (Exactly, since no fractions were generated) 



The above example sums the six-digit fields found in the first 48 columns of a card. 
Each data field has two decimal places. Any arithmetic operation can be performed 
with GET ( ) as an operand. 
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E rrors : If a nonnumeric character, other than blank, appears in a position other than 
the low-order position, the result is set to zero. 

If a special character other than - (minus) appears in the low-order position, the result 
is set to zero. 

Remarks : The GET routine is a function subprogram. As such, it is used in an arith- 
metic expression as shown in the example. 

When using standard FORTRAN I/O, and the digit in the units position is a zero, a minus 
sign is shown as an 11-punch only; a plus is shown as a zero-punch only. 

In most cases the value of SHIFT should be 1.0, placing the decimal point at the right- 
hand end of the number. (For dollars and cents calculations, the result of the GET would 
be in cents. ) This will eliminate precision errors from the calculations. The decimal 
point may be replaced (moved to the left) with the EDIT routine for output. 

If GET (or PUT) is used, the calling program must use extended precision . 
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ICOMP 

Format : ICOMP (JCARD, J,JLAST,KCARD,K,KLAST) 

Function : Two variable-length decimal format data fields are compared. The result 
is set to a negative number, zero, or a positive number. This is a function subprogram. 

Parameter description : 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the first data field to be compared, one 
digit per word, in decimal format. 

J - An integer constant, an integer expression, or an integer variable. 
This is the position of the first character of JCARD to be compared 
(the left-hand end of a field) . 

JLAST - An integer constant; an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last character 
of JCARD to be compared (the right-hand end of a field). 

KCARD - The name of a one- dimensional integer array defined in a DIMENSION 
statement. This array contains the second data field to be compared, 
one digit per word, in decimal format. If the fields are unequal in 
length, the KCARD field must be the longer field. 

K - An integer constant, an integer expression, or an integer variable. 
This is the position of the first character of KCARD to be compared 
(the left-hand end of a field) . 

KLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to K. This is the position of the last character 
of KCARD to be compared (the right-hand end of a field). 

Detailed description : Since the fields are assumed to be right-justified, the first 
operation is to examine the length of each field. If KCARD is longer than JCARD, the 
leading digits of KCARD are examined. If any one of them is greater than zero the 
result (ICOMP) is the opposite sign of KCARD. If they are all zero, or if the lengths 
are equal, corresponding digits are compared. The routine operates from left to right. 
The routine terminates when KCARD is longer than JCARD and a nonzero digit appears 
in the high-order of KCARD, when JCARD and KCARD do not match, or when all digits 
in JCARD and KCARD are equal. The following table shows the value of ICOMP, 
depending on the relation of the JCARD field to the KCARD field: 
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ICOMP 



Relation 



- (minus) 
(zero) 
+ (plus) 



JCARD is less than KCARD 
JCARD is equal to KCARD 
JCARD is greater than KCARD 
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More detailed information may be found in the ICOMP flowchart and listing. 



Example: DIMENSION ITOT(IO) ,ICTL(10) 

IF (ICOMP(ICTL,1,10,ITOT,1,10)) i j2 ,l 

The control total is compared to the total calculated. Control goes to statement 1 if the 
totals do not match (the calculated total is greater than or less than the control total) . 
Control goes to statement 2 if the calculated total is equal to the control total. The fields 
compared are not changed. 

ITOT 0007136673 

ICTL 0007136688 

ICOMP after is positive. 



Errors : No errors are detected. However, the JCARD field must riot be longer than the 
KCARD field. 

Remarks : ICOMP is a function subprogram and as such should be used in an arithmetic 
expression. 

If JLAST is less than J, or KLAST is less than K, the result is unpredictable. 
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IOND 



Format: CALL IOND 



Function: Checks for I/O interrupts and loops until no I/O interrupts are pending. 

This subroutine should not be used in conjunction with Version 2 of the 1130 Disk Monitor 
System. It is unneeded; besides, it may not operate correctly. It (IOND) is required 
only for programs operating under control of Version 1 of the Monitor. 

Detailed description: The routine checks the Interrupt Service Subroutine Counter to see 
whether any I/O interrupts are pending. If the counter is not zero, the routine continues 
to check it until it becomes zero. Then the routine returns control to the user. More 
detailed information may be found in the IOND flowchart and listing. 



Example: CALL IOND 
PAUSE 777 



The two statements shown will wait until all I/O interrupts have been serviced. Then the 
program will PAUSE. If an I/O interrupt is pending, and IOND is not used before a 
PAUSE, the program will not PAUSE. 

Errors: None 

Remarks : This statement must always be used before a STOP or PAUSE statement. 

It may also be helpful in debugging programs. Sometimes, with more than one event 
going on at the same time (PRINTing and processing) during debugging, difficulties can be 
encountered. The user may not be able to easily find the cause of trouble. The use of 
IOND after each I/O statement will ensure that only one I/O operation is going on at any 
given time. 
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KEYBD 

Format : CALL KEYBD(JCARD,J,JLAST) 
Function ; Reads characters from the keyboard. 
Parameter description : 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array will contain the keyed information when reading 
is finished. The information will be in Al format, one character per 
word. 

An integer constant, an integer expression, or an integer variable. 
This is the position of the first word of JCARD into which a character 
will be keyed (the left-hand end of a field). 

An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last word of 
JCARD into which a character will be keyed (the right-hand end of a 
field). 

Detailed description : The keyboard is read and the information being read is printed on 
the console printer. When the specified number of characters have been read, or when 
EOF is encountered, the reading terminates. The characters read are converted from 
keyboard codes to EBCDIC and placed in Al format, one character per word. Control is 
now returned to the user. More detailed information may be found in the TYPER/ 
KEYBD flowchart and listing. 



J - 



JLAST - 



Example: DIMENSION INPUT(30) 

CALL KEYBD(INPUT,1,27) 



Before: 



INPUT ABCDEFGHIJKLMNOPQRSTUVWXYZ0123 



Position 1 



10 



15 20 



25 30 



After: 



INPUT THE CUSTOMER NAME GOES HERE123 



Position 1 



10 



15 



20 



25 



30 



The array INPUT, from INPUT(l) to INPUT(27), has been filled 
with information read from the keyboard. 
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Errors : The f ollowing WAITs may occur: 

WAIT (loc) Accumulator (hex) Action 

41 2xx0 Ready the keyboard. 

41 2xxl Internal subroutine error. 

Rerun job. If error persists, verify 
that the subroutine deck is accurate 
using the listing in this manual. If the 
deck is the same, contact your local 
IBM representative. Save all output. 

Only 60 characters at a time may be read from the keyboard. 

If more than 60 characters are specified (JLAST-J+1 is greater than 60), only 
60 characters will be read. 

Remarks: The characters asterisked in Appendix D of IBM 1130 Subroutine Library 
(C26-5929) will be entered into core storage and printed. All other characters will 
be entered into core storage but will not be printed. 

If this subroutine is used, all other I/O must use commercial routines. 
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MOVE 

Format : CALL MOVE(JCARD,J,JLAST,KCARD,K) 
Function : Moves data from one array to another array. 
Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the array from which data is moved. The data may 
be stored in JCARD in any format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be moved (the left-hand 
_ end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be moved (the right-hand end of a field). 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This is the array to which data is moved, one character per 
word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of KCARD to which data will be 
moved (the left-hand end of a field). 

Detailed description: Characters are moved, left to right, from the sending field, 
■ JCARD, starting with JCARD(J) and ending with JCARD(JLAST), to the receiving field 
KCARD, starting with KCARD(K). More detailed information may be found in the MOVE 
flowchart and listing. 
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Example: DIMENSION INPUT(80),IOUT(120) 
L=20 
K=14 
CALL MOVE(INPUT,6,L,IOUT,K) 



Before: 



INPUT 



IOUT 



bbbbl2ABC45ZYXPQR999Ab. . . bbbbbblbb77b6ABCDEFGHIJKLMNOPb. 

4 4 4 444 4 4 



Position 1 5 10 15 20 Position 15 10 15 20 25 30 



After: 



INPUT is the same. 



IOUT 



bbbbbblbb77b62ABC45ZYXPQR999Pb. . . 

Hit I I I 

Position! 15 10 15 20 25 30 

The field in the array INPUT, starting at INPUT(6) and ending at INPUT(20), is moved 
to the field in the array IOUT, starting at IOUT(14). A total of 15 characters are moved. 



Errors: None 
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MPY 

Format : CALL MPY(JCARD,J,JLAST,KCARD,K,KLAST,NER) 

Function : Multiplies two arbitrary-length decimal data fields, placing the product in the 
second data field. 

Parameter description: 

JCARD - The name of a one -dimensional integer array defined in a DIMENSION 
statement. This array is the multiplier. The data must be stored in 
JCARD in decimal format, one digit per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first digit that will multiply (the left-hand end of a 
field). 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last digit to mul- 
tiply (the right-hand end of a field). 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array, the multiplicand, will contain the product, ex- 
tended to the left, in decimal format, one digit per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first digit of the multiplicand (the left-hand end of a 
field). 

KLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to K. This is the position of the last character of 
the product and the multiplicand (the right-hand end of a field). 

NER - An integer variable. This variable will indicate whether the KCARD 
field is - not long enough. 

Detailed description : First the signs are cleared from both fields and saved. Then the 
KCARD field is extended to the left the length of the JCARD field (JLAST- J+l) and filled 
with zeros. If the KCARD field will be extended below KCARD (1), NER will be set 
equal to KLAST and the routine will be terminated. Next, the JCARD field is scanned to 
find the high-order significant digit. If no digit is found, the result is set to zero. When 
a digit is found, the actual multiplication begins. The significant digits in the JCARD 
field are multiplied by the digits in the KCARD field, one at a time, starting with 
KCARD(K) and ending with KCARD(KLAST). The preliminary results are summed, 
shifting after each preliminary multiplication to give the correct place value to the pre- 
liminary results. Finally, the correct sign is generated for the result, in KCARD, and 
the sign of JCARD is restored. More detailed information may be found in the MPY 
flowchart and listing. 
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Example: DIMENSION MPLR(5),MCAND(15) 

N=0 
CALL MPY(MPLR,1,5,MCAND,6,15,N) 



Before: 



MPLR 00982 



Position 1 

N=0 



MCAND ABCDE0007136673 

A 



Position 



10 15 



After: 



MPLR is unchanged. 
N=0 



MCAND 000007008212886 



Position 



10 15 



The numeric data fields MPLR and MCAND are multiplied, the result being placed in 
MCAND. Note that the MCAND field has been extended to the left the length of the 
MPLR field, five positions, and that N has not been changed. 



Errors: If there is not enough room to extend the KCARD field to the left, NER will be 
set equal to KLAST, and the routine will terminate. 

Remarks: Conversion from EBCDIC to decimal is necessary before using this subroutine. 
This may be accomplished with the A1DEC subroutine. The length of the JCARD and 
KCARD fields is arbitrary, up to the maximum space available. 

The arithmetic performed is decimal arithmetic, using whole numbers only. 

Space must always be provided in the KCARD field for expansion. The first position of 
the multiplicand, K, must be at least JLAST-J+1 positions from the beginning of 
KCARD. For example, if JCARD is 7 positions, 1 through 7, then the multiplicand, 
in KCARD, must start at least seven positions (7-1+1=7) from the beginning of KCARD. 
This would have K equal to 8. 

The product, located in the KCARD field, will begin at position K-(JLAST-J+1) of 
KCARD, and end at position KLAST of KCARD. 
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J - 



NCOMP 

Format: NCOMP(JCARD,J,JLAST,KCARD,K) 

Function : Two variable -length data fields are compared, and the result is set to a nega- 
tive number, zero, or a positive number. This is a function subprogram. 

Parameter description: 

JCARD - The name of a one -dimensional integer array defined in a DIMENSION 
statement. This array contains the first data field to be compared, one 
character per word, in Al format. 

An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be compared (the left- 
hand end of a field). 

An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last character of 
JCARD to be compared (the right-hand end of a field). 

The name of a one -dimensional, integer array defined in a DIMENSION 
statement. This array contains the second data field to be compared, 
one character per word, in Al format. 

An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of KCARD to be compared (the left- 
hand end of a field). 

Detailed description : Corresponding characters of JCARD and KCARD are compared 
logically, starting with JCARD(J) and KCARD(K). The routine operates from left to 
right. The routine terminates when JCARD and KCARD do not match, or when the char- 
acter at JCARD (JLAST) has been compared. The following table shows the value of 
NCOMP, depending on the relation of the JCARD field to the KCARD field: 



JLAST - 



KCARD 



K 



NCOMP 
- (minus) 
(zero) 
+ (plus) 



Relation 
JCARD is less than KCARD 
JCARD is equal to KCARD 
JCARD is greater than KCARD 



More detailed information may be found in the NCOMP flowchart and listing. 
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Example: DIMENSION IN(80),MASTR(80) 

IF (NCOMP(IN,1,20,MASTR,1))1 9 2,3 

The field on the input card starting in column 1 and ending in column 20 is compared 
with the master field. Control goes to statement 1 if the input card is less than the mas- 
ter card. Control goes to statement 2 if the input card equals the master card. Control 
goes to statement 3 if the input card is greater than the master card. The fields com- 
pared are not changed. 

IN 1234567bbbbbbbABCDEF 

MASTR 12345 67bbbbbbbABCDEF 

NCOMP after is zero 



Errors : None 

Remarks : The collating sequence in ascending order is as follows: 

A,B,C,D,E,F,G,H,I , J ,K,L,M,N,0,P,Q,R,S,T,U,V,W ) X > Y,Z ,0,1,2,3,4,5,6,7,8,9, 

blank,., <,(, + ,&,$,*,),-, /,,,%,#,©,•,= 

The compare operation is terminated by the last character of the first data field, the data 
field at JCARD, or by an unequal comparison. NCOMP is a function subprogram and as 
such should be used in an arithmetic statement. 
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NSIGN 

Format : CALL NSIGN(JCARD,J,NEWS,NOLDS) 

Function : Interrogate the sign and return with a code as to what the sign is. Also, 
modify the sign as specified. 

Parameter description: 

JCARD - The name of a one- dimensional integer array defined in a DIMENSION 
statement. This array contains the digit to be interrogated or modified, 
in decimal (Dl) format. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the digit to be interrogated or modified. 

NEWS - An integer constant, an integer expression, or an integer variable. This 
is the code specifying the desired modification of the sign. 

NOLDS - An integer variable. Upon completion of the routine, this variable con- 
tains the code specifying what the sign was. 

Detailed description: The sign is retrieved and NOLDS is set as in the table below: 

NOLDS is When the sign was 

+1 positive 

-1 negative 

Then a new sign is inserted, specified by NEWS, as shown in the table below: 



NEWS 



+1 

-1 
NOLDS 
More detailed information may be found in the NSIGN flowchart and listing. 



Sign 
positive 

opposite of old sign 
negative 
no change 
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Example: DIMENSION INUMB(9) 

CALL NSIGN(INUMB,9,0,N) 



Before: 



N=0, INUMB(9)=7 



After: 



N=l, INUMB(9)= -7 



Errors: None 



Remarks: The digit processed must be in decimal (Dl) format. If it is not, the results 
are meaningless. 
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NZONE 

Format : CALL NZONE (JCARD,J,NEWZ, NO LDZ) 

Function : Interrogate the zone and return with a code as to what the zone is. Also, 
modify the zone as specified. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the character to be interrogated or 
modified, in Al format. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the character in JCARD to be interrogated or modified. 

NEWZ - An integer constant, an integer expression, or an integer variable. This 
is the code specifying the modification of the zone . 

NO LDZ - An integer variable. This variable contains the code specifying what the 
zone was. 

Detailed description : The zone is retrieved and NOLDZ is set as in the table below: 



NOLDZ is 
1 
2 
3 
4 
more than 4 



When the character was 
A-I 
J-R 
S-Z 
0-9 
special 



Then a new zone is inserted, specified by NEWZ, as shown in the table below: 

NEWZ Character 

1 12 zone 



2 


11 zone 


3 


zone 


4 


no zone 


! than 4 


no chani 
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When a special character is the original character, the zone will not be changed. More 
detailed information may be found in the NZONE flowchart and listing. 



Example: 


DIMENSION IN (80) 
CALL NZONE(IN,l,2,J) 


Before: 


J= 

IN(1) = a B (a 12, 2 punch) 


After: 


J= 1 

IN(1) = a K (an 11,2 punch) 



Errors : None 

Remarks : The minus sign or dash (-, an 11-punch) is treated as if it were a negative 
zero, not as a special character. This is the only exception. 

The only modification performed on an input minus sign is that it may be transformed to 
a digit zero with no zone (a positive zero). 
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PACK 

Format : CALL PACK(JCARD,J,JLAST,KCARD,K) 

Function: Information in Al format, one character per word, is PACKed into A2 format, 
two characters per word. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the input array, containing the data in Al format, 
one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be PACKed (the left- 
hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than J. This is the position of the last character of JCARD to 
be PACKed (the right-hand end of a field). 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the array into which the data is PACKed, in A2 for- 
mat, two characters per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of KCARD to receive the PACKed 
characters (the left-hand end of a field). 

Detailed description : The characters in the JCARD array are taken in pairs, starting 
with JCARD(J), and PACKed together into one element of KCARD, starting with 
KCARD(K). Since the characters are taken in pairs, an even number of characters will 
always be PACKed. IE necessary, the character at JCARD (JLAST+1) will be used in 
order to make the last data PACKed a pair. More detailed information may be found in 
the PACK/UNPAC flowchart and listing. 
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Example: DIMENSION IUNPK(26),IPAKD(26) 

CALL PACK(IUNPK,1,25,IPAKD,1) 



Before: 



IUNPK AbBbCbDbEbFbGbHblbJbKbLbMbNbObPbQbRbSbTbUbVbWbXbYbZb 



Position 



10 



15 



20 



25 



IPAKD 0blb2b3b4b5b6b7b8b9b0blb2b3b4b5b6b7b8b9b0blb2b3b4b5b 

4 # A 



Position 



10 



15 



20 



25 



After: 



IUNPK is the same. 

IPAKD ABCDE FGHIJKLMNOPQRSTUVWXYZ3b4b5b6b7b8b9b0blb2b3b4b5b 

4 4 4 



Position 



10 



15 



20 



25 



Note that each two characters shown above represent one element of the array. 
Also, after IUNPK has been PACKed, the twenty-sixth character, Z, has been 
PACKed since 25 characters were specified (between J and JLAST). 



Errors : None 

Remarks : If JLAST is less than or equal to J, the first two characters of JCARD will be 
PACKed. An even number of characters in JCARD will always be PACKed into KCARD. 
An equation for how much space is required, in elements, in KCARD is 



Space in KCARD 
This result is rounded down at all times. 



[ jLAST-J+2 1 



-61- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT - 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



PRINT 

Format : CALL PRINT(JCARD,J,JLAST,NER) 

Function : The printing of one line on the IBM 1132 Printer is initiated, and control 
is returned to the user. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the information to be printed, on the 
IBM 1132 Printer, in Al format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be printed (the left- 
hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be printed (the right-hand end of a field). 

NER - An integer variable. This variable indicates carriage tape phannel con- 
ditions that have occurred in printing. 

Detailed description: When the previous print operation is finished, if a print operation 
was going on, the routine begins. The characters to be printed are packed and reversed. 
Since the characters are taken in pairs, an even number of characters is required. If 
necessary, the character at JCARD (JLAST+1) will be used to get an even number. Then 
printing is initiated and control is returned to the user. When printing is finished, the 
printer spaces one line and the indicator, NER, is set as follows: 



NER is 



when 



Channel 9 has been encountered 



Channel 12 has been encountered 



If channel 9 or channel 12 is not encountered, the indicator is not set. 
If a WAIT occurs at location 41, one of the following conditions exists: 



Condition 

Printer not ready or end of forms. 

Internal subroutine error. Rerun job. If 
error persists, verify that the subroutine 
deck is accurate, using the listing in this 
manual. If the deck is the same, contact 
your local IBM representative. Save all out- 
put. 



Accumulator (hex) 
6xx0 
6xxl 
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All of the above WAITs require operator intervention. 

Only one line can be printed at a time (JLAST-J+1 must be less than or equal to 120). 

More detailed information may be found in the PRINT/SKIP flowchart and listing. 



Example: DIMENSION IOUT(120) 

N=0 

CALL PRINT(IOUT,1,120,N) 
IF(N-3) 1,2,3 

2 Channel 9 routine 

3 Channel 12 routine 

1 Normal processing 

The line in IOUT, from IOUT(l) through IOUT(120), is printed. The indicator is tested 
to see whether (1) the line was printed at channel 9 or (2) the line was printed at channel 
12. Appropriate action will be taken. 

Notice that the test of the indicator is made after printing . The test should always be 



performed in this way to see where the line has just been printed. If the indicator was 



set, the line was printed at channel 9 or channel 12. 



Errors : If JLAST is less than J, only one character will be printed. If more than 120 
characters are specified (JLAST-J+1 is greater than 120), only 120 characters will be 
printed. 

Remarks : After each line is printed, the condition indicator should be checked for the 
channel 9 or channel 12 indication. In doing this the same variable should always be used 
for the indicator. 

The indicator is not reset by the subroutine. It is the responsibility of the user to initial- 
ize and reset this indicator. 

If this subroutine is used, any other I/O must use commercial subroutines, with the 
exception of disk, which must always use FORTRAN I/O. 
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PUNCH 

Format : CALL PUNCH(JCARD,J,JLAST,NER) 

Function: Punches a card on the IBM 1442, Model 6 or 7. See Subroutine P1442 for 
punching on the 1442 Model 5. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This array contains the characters to be punched into a card, 
in Al format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be punched (the left- 
hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be punched (the right-hand end of a field). 

NER - An integer variable. This variable indicates any conditions that have 
occurred in punching a card, and the nature of these conditions. 

Detailed description: The characters to be punched are converted from EBCDIC to card 
codes, one at a time. When all characters have been converted, the punching operation 
is initiated. If an error occurs during the operation, the condition indicator is set, and 
the operation is continued. The possible values of the condition indicator and their mean- 
ing are listed below: 

NER is when 

Last card condition. 

1 Feed or punch check. 
Operator intervention 
required. 

If a WAIT occurs at location 41, one of the following conditions exists: 

Conditions Accumulator (hex) 



Punch not ready. 

Internal subroutine error. Rerun job. 
If error persists, verify that the sub- 
routine deck is accurate, using the 
listing in this manual. If the deck is 
the same, contact your IBM repre- 
sentative. Save all output. 

All of the above WAITs require operator intervention. 



lxxO 
lxxl 
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Only one card can be punched at a time (JLAST-J+1 must be less than or equal to 80). 
More detailed information may be found in the READ/PUNCH flowchart and listing. 



Example: DIMENSION IOTPT(80) 

N=-l 
CALL PUNCH(IOTPT,1,80,N) 



Before: 



IOTPT NAME. . . ADDRESS. . . AMOUNT 



Position 



20 



60 



N=-l 



After: 



IOTPT is the same. 



N=0 



The information in IOTPT, from IOTPT(l) to IOTPT(80), has been punched into a card 
Since N=0, the information was punched correctly, and the card punched into was the 
last card. 



Errors : K a punch or feed check occurs, the condition indicator will be set equal to 1. 
If an internal error occurs, the system will WAIT as specified above. 

If more than 80 characters are specified (JLAST-J+l is greater than 80), only 80 charac- 
ters, one card, will be punched. 

Remarks : After each card is punched, the condition indicator should be checked for the 
last card indication. This will occur only after the last card has physically been 
punched. 

The condition indicator is not reset by the subroutine. It is the responsibility of the user 
to initialize and reset this indicator. 

If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 
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PUT 

Format ; CALL PUT(JCARD,J,JLAST,VAR,ADJST,N) 

Function : Converts the whole portion of a real variable, VAR, to an EBCDIC integer 
number, half-adjusting as specified, and places the result, after decimal 
point alignment, in an array. An il-zone is placed over the low-order, 
rightmost position in the array if VAR is negative. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array will contain the result of the PUT routine, 
EBCDIC coded information, in Al format, one digit per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the first position of JCARD to be filled with the result (the left-hand 
end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the last position to be filled with the 
result (the right-hand end of a field). 

VAR - A real constant, a real expression, or a real variable. This is the num- 
ber whose whole portion will be PUT. 

ADJST - A real constant, a real expression, or a real variable. This is added to 
the variable, VAR, as a half- adjustment factor. 

N - An integer constant, an integer expression, or an integer variable. This 
specifies the number of digits to truncate from the right-hand end of the 
number, VAR. 

Detailed description: First, the half- adjustment factor is added to the real variable, 
VAR. Then, each digit is retrieved using the formula 

EBCDIC DIGIT = 256 (BINARY DIGIT) - 4032 

and placed in the output area. Each binary digit is retrieved by subtracting the digits 
already retrieved from VAR and multiplying by 10. The next digit is then retrieved and 
placed in the output area. More detailed information may be found in the PUT flowchart 
and listing. 
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Example: DIMENSION IPRNT(120) 

CALL PUT(IPRNT,1,12,A,5.0,1) 



Before: 



A = 1234567. 



IPRNT ABCDEFGHIJKLMNOPQRSb 



Position 



10 



15 



20 



After: 

A = 1234567. 

IPRNT 000000123457MNOPQRSb 
{♦lit 
Position 1 5 10 15 20 



Errors : None 

Remarks: If the receiving field, JCARD, is not large enough to hold all of the output, 
only the low -order digits are placed. 

If JLAST is less than or equal to J, only one digit will be PUT. 

It is necessary for the programmer to use the ADJST parameter in every PUT. For 
example, assume that the number to be PUT is 123. 00. Because the IBM 1130 is a binary 

machine, the number may be represented in core storage as 122. 999 If this number is 

PUT with ADJST equal to zero, the result will be 122. However, with ADJST equal to 

0. 5, the preliminary result is 123. 499; when PUT, the result is 123. The value of ADJST 

should be a 5 in the decimal position one to the right of the low-order digit to be PUT. 

The last two factors, ADJST and N, form a logical pair, and should usually appear as 
either: 



ADJST 



N 





.5 


and 





or 


5. 


and 


1 


or 


50. 


and 


2 


or 


500. 


and 


3 




etc. 




etc 



ADJST should never be less than .5, since this will introduce fraction inaccuracies. 
From this it follows that N should never be negative. 

If PUT (or GET) if? used, the calling program must use extended precision. 
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P1403 



Format: CALL P1403(JCARD, J, JLAST, NER) 

Function : The printing of one line on the IBM 1403 Printer, Model 6 or 7, is initiated, 
and control is returned to the user. 

Parameter description: 



JCARD - 



J - 



JLAST - 



The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the information to be printed, on the 
IBM 1403 Printer, in Al format, one character per word. 

An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be printed (the left-hand 
end of a field). 

An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last character of 
JCARD to be printed (the right-hand end of a field). 

NER - An integer variable. This variable indicates carriage control tape condi- 
tions that have occurred in printing. 

Detailed description : When the previous print operation is finished, if a print operation 
was going on, the routine begins. The characters to be printed are converted to 1403 
Printer codes and reversed so as to match the 1403 buffer mechanism. Since the char- 
acters are taken in pairs, an even number of characters is required. If necessary, the 
character at JCARD(JLAST+1) will be used to get an even number. Printing is then 
initiated and control is returned to the user. When printing is finished, the printer spaces 
one line and the indicator, NER, is set as follows: 

NER is when 

3 Channel 9 has been encountered 

4 Channel 12 has been encountered 

If neither channel 9 nor channel 12 is encountered, the indicator is not set. If a WAIT 
occurs at location 41, one of the following conditions exists: 



Conditions 
Printer not ready or end of forms. 

Internal subroutine error. Rerun job. If error persists, 
verify that the subroutine deck is accurate, using the listing 
in this manual. If the deck is the same, contact your local 
IBM representative. Save all output. 

All of the above WAITs require operator intervention. 



Accumulator (hex) 
9000 
9001 
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Only one line can be printed at a time (JLAST-J+1 must be less than or equal to 120). 
More detailed information may be found in the P1403 flowchart and listing. 



Example: DIMENSION IOUT(120) 

N=0 

CALL P1403(IOUT, 1, 120, N) 
IF(N-3)1,2,3 

2 Channel 9 routine 

3 Channel 12 routine 

1 Normal processing 

The line in IOUT, from IOUT(l) through IOUT(120), is printed. The indicator is tested 
to see whether (1) the line was printed at channel 9 or (2) the line was printed at channel 
12. Appropriate action will be taken. 

Notice that the test of the indicator is made after printing. The test should always be 
performed in this way to see where the line has just been printed. If the indicator was 
set, the line was printed at channel 9 or channel 12. 



Errors: If JLAST is less than J, two characters will be printed. If more than 120 char- 
acters are specified (JLAST-J+1 is greater than 120), only 120 characters will be printed. 

Remarks : After each line is printed, the condition indicator should be checked for the 
channel 9 or channel 12 indication. In doing this, the same variable should always be 
used for the indicator. 

The indicator is not reset by the subroutine. It is the responsibility of the user to 
initialize and reset this indicator. 

If this subroutine is used, any other I/O must use commercial subroutines, with the 
exception of disk, which must always use FORTRAN I/O. 

This CSP subroutine uses three subprograms that are part of the Disk Monitor Version 2 
subroutine library. If P1403 is to be used with Version 1 of the Monitor, ZIPCO, EBPT3, 
and PRNT3 must be loaded onto the Version 1 disk cartridge. 
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P1442 



Format: CALL P1442(JCARD, J, JLAST.NER) 

Function : Punches a card on the IBM 1442, Model 5, 6, or 7. 

Parameter description : 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This array contains the characters to be punched into a card, 
in Al format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be punched (the left-hand 
end of a field) . 

JLAST - An integer constant, an integer expression, or a,n integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be punched (the right-hand end of a field). 

NER - An integer variable. ..This variable indicates any conditions that have 
occurred in punching a card, and the nature of these conditions. 

Detailed description: The characters to be punched are converted from EBCDIC to card 
- codes, one at a time. When all characters have been converted, the punching operation 
is initiated. If an error occurs during the operation, the condition indicator is set, and 
the operation is continued. The possible values of the condition indicator and their 
meaning are listed below: 



NER is 

1 



when 
Last card condition. 
Feed or punch check. Operator intervention required. 



If a WAIT occurs at location 41, one of the following conditions exists: 



Conditions 



Accumulator (hex) 



Punch not ready. 

Internal subroutine error. Rerun job. If error persists, 
verify that the subroutine deck is accurate, using the listing 
in this manual. If the deck is the same, contact your IBM 
representative. Save all output. 

All of the above WAITs require operator intervention. 



lxxO 
lxxl 
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Only one card can be punched at a time (JLAST- J+l must be less than or equal to 80). 
More detailed information may be found in the P1442 flowchart and listing. 



Example: DIMENSION IOTPT(80) 
N = -1 
CALL P1442(IOTPT,1,80,N) 



Before: 

IOTPT NAME. . . ADDRESS. . . AMOUNT 

Position 1 20 60 

N = -1 



After: 

IOTPT is the same. 

N = 

The information in IOTPT, from IOTPT(l) to IOTPT(80), has been punched into a card. 
Since N = 0, the information was punched correctly, and the card punched into was the 
last card. 



Errors: If a punch or feed check occurs, the condition indicator will be set equal to 1. 
If an internal error occurs, the system will WAIT as specified above. 

If JLAST is less than J, only one character will be punched. 

If more than 80 characters are specified (JLAST- J+l is greater than 80), only 80 
characters, one card, will be punched. 

Remarks: After each card is punched, the condition indicator may be checked for the 
last-card indication. This will occur only after the last card has physically been 
punched. 

The condition indicator is not reset by the subroutine. It is the responsibility of the 
user to initialize and reset this indicator. 
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If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 

If a program contains no calls to the READ subroutine, this routine (P1442) may be used 
to punch cards on the 1442, Model 6 or 7, at a considerable savings in core storage. 
This is due to the fact that READ and PUNCH are two different entry points to the same 
subroutine. A call to one or both will cause the READ/PUNCH routine to be added to 
the core load. P1442 is smaller in size, since it is basically the PUNCH portion of the 
READ/PUNCH routine. A program may ncrt CALL both READ/PUNCH and P1442; the 
Monitor will refuse to load two I/O routines that service the same device. To feed the 
first card, a P1442 CALL may be issued, punching 80 blanks. 

This CSP subroutine uses part of the Disk Monitor Version 2 subroutine library. If 
P1442 is to be used with Version 1 of the Monitor, PNCH1 must be loaded onto the 
Version 1 disk cartridge. 
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READ 

Format : CALL READ(JCARD,J,JLAST,NER) 

Function: Reads a card from the IBM 1442, Model 6 or 7, only, overlapping the conver- 
— ^^^ from card codes to EBCDIC. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. A card will be read into this array, in Al format, one char- 
acter per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first word of JCARD into which a character will 
be read (the left-hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last word of 
JCARD into which a character will be read (the right-hand end of a 
field). 

NER - An integer variable. This variable indicates any conditions that have oc- 
curred in reading a card, and the nature of these conditions. 

Detailed description: A card read operation is started. While the card is being read, 
the characters, one at a time, are converted from card codes to EBCDIC. If an error 
occurs during the operation, the condition indicator is set, and the operation continues. 
The possible values of the condition indicator and their meaning are listed below: 

NER is when 

Last card condition. 

1 Feed or read check. 
Operator intervention 
required. 

If a WAIT occurs at location 41, one of the following conditions exists: 

Conditions Accumulator (hex) 
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Reader not ready. 

Internal subroutine error. Rerun job. 
If error persists, verify that the sub- 
routine deck is accurate, using the 
listing in this manual. IE the deck is 
the same, contact your IBM repre- 
sentative. Save all output. 



lxxO 
lxxl 
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All of the above WAlTs require operator intervention. 

Only one card can be read at a time (JLAST-J+1 must be less than or equal to 80). More 
detailed information may be found in the READ/PUNCH flowchart and listing. 



Example: DIMENSION INPUT(160) 

Nl=-1 

CALL READ(INPUT,1,80,N1) 
N2— 1 
CALL READ(INPUT,81,160,N2) 



Before: 



INPUT 000000. . . 0000000000 



Position 1 

Nl=-1 
N2=-l 



155 160 



After: 



INPUT THIS IS THE NAME. . . SECOND CARD. . . 



, 


. 


1, 


, 


, 



Position 1 5 10 15 80 81 85 90 

Nl=-1 
N2=-l 



160 



From the user's viewpoint the next card is read into the INPUT array (1-80). Nl is not 
one of the indicated values, so the first read was successful. The next card is read into 
the INPUT array (81-160). N2 is not one of the indicated values, so the second read was 
also successful. 

Errors : If a read or feed check occurs, the condition indicator will be set equal to 1. If 
an internal error occurs, the system will WAIT as specified above. 

If more than 80 characters are specified (JLAST-J+1 is greater than 80), only 80 charac- 
ters, one card, will be read. 
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Remarks : After each card read, the condition indicator may be checked for the last 
card indication. This will occur only after the last card has physically been read into 
core storage. 

The condition indicator is not reset by the subroutine. It is the responsibility of the 
user to initialize and reset this indicator. 

If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 

Note that the READ subroutine will not detect Monitor // control cards, as opposed to 
the standard FORTRAN READ, which exits when such a card is encountered. 
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R2501 



Format ; CALL R2501(JCARD, J, JLAST.NER) 

Function : Reads a card from the IBM 2501, Model Al or A2 only, overlapping the con- 
version from card codes to EBCDIC. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. A card will be read into this array, in Al format, one char- 
acter per word. This array should always be 80 words in length. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first word of JCARD into which a character will be 
read (the left-hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, greater 
than or equal to J. This is the position of the last word of JCARD into 
which a character will be read (the right-hand end of a field). 

NER - An integer variable. This variable indicates any conditions that have oc- 
curred in reading a card, and the nature of these conditions. 

Detailed description : A card read operation is started. While the card is being read, 
the characters, one at a time, are converted from card codes to EBCDIC. If an error 
occurs during the operation, the condition indicator is set, and the operation continues. 
The possible values of the condition indicator and their meaning are listed below: 



NER is 



when 

Last card condition. 

Feed or read check. Operator intervention 
required. 



If a WAIT occurs at location 41, one of the following conditions exists: 



Conditions 

Reader not ready. 

Internal subroutine error. Rerun job. If 
error persists , verify that the subroutine 
deck is accurate, using the listing in this 
manual. If the deck is the same, contact 
your IBM representative. Save all output. 

All of the above WAITs require operator intervention. 



A ccumulator (hex) 
lxxO 
lxxl 
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Only one card can be read at a time (JLAST-J+1 must be less than or equal to 80). More 
detailed information may be found in the R2501 flowchart and listing. 



Example: DIMENSION INPUT(160) 




Nl=-1 




CALL R2501(INPUT, 1, 80, Nl) 




N2=-l 




CALL R2501(INPUT,81,160,N2) 




Before: 






INPUT 000000. . . 0000000000 

f 1 11 

Position 1 5 155 160 




Nl=-1 






N2=-l 






After: 






INPUT THISblSbTHEbNAME . . . SECONDbC ARD 

111 f tl 1 1 

Position 1 5 10 15 80 81 85 90 


1 

160 


Nl=-1 






N2=-l 







The first card is read into the INPUT array (1-80). Nl is not one of the indicated values, 
so the first read was successful. The next card is read into the INPUT array (81-160). 
N2 is not one of the indicated values, so the second read was also successful. 

Errors : If a read or feed check occurs, the condition indicator will be set equal to 1. 
If an internal error occurs, the system will WAIT as specified above. 

If more than 80 characters are specified (JLAST-J+1 is greater than 80), only 80 char- 
acters, one card, will be read. 
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Remarks: After each card read, the condition indicator may be checked for the last- 
card indication. This will occur only after the last card has physically been read into 
core storage. 

The condition indicator is not reset by the subroutine. It is the responsibility of the user 
to initialize and reset this indicator. 

If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 

Note that the R2501 routine does not detect Monitor // control cards, as opposed to the 
standard FORTRAN READ, which exits when such a card is encountered. 

This CSP subroutine uses part of the Disk Monitor Version 2 subroutine library. If 
R2501 is to be used with Version 1 of the Monitor, READ1 must be loaded onto the 
Version 1 disk cartridge. 
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SKIP 

Format : CALL SKIP(N) 

Function : Execute the requested control function on the IBM 1132 Printer 

Parameter description: 



N 



An integer constant, an integer expression, or an integer variable. The 
value of this variable corresponds to an available control function. 



Detailed description : If the printer is busy, the subroutine WAITs. Otherwise, or when 
the printer finishes, the routine executes the requested function and returns control to 
the calling program. The control functions and their values are as follows: 



Function 
Immediate skip to channel 1 
Immediate skip to channel 2 
Immediate skip to channel 3 
Immediate skip to channel 4 
Immediate skip to channel 5 
Immediate skip to channel 6 
Immediate skip to channel 9 
Immediate skip to channel 12 
Immediate space of 1 space 
Immediate space of 2 spaces 
Immediate space of 3 spaces 
Suppress space after printing 
Normal spacing is one space after printing. 



Value 
12544 
12800 
13056 
13312 
13568 
13824 
14592 
15360 
15616 
15872 
16128 




ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

- SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



Example: NUMBR=12544 ~~ 

CALL SKIP(NUMBR) 

The carriage skips until a punch in channel 1 of the carriage control tape is encountered 
(normally this is at the top of a page). 
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Errors ; Only the codes mentioned above can be used. The use of anything else will re- 
sult in either no movement of the carriage or a WAIT at location 41 with 6xxl in the 
accumulator (hex). 

Remarks: When space suppression after printing is executed, it is reset to single-space 
after printing. If the user wishes to continue suppression, he must reissue the suppres- 
sion command. 

If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 



-80- 



STACK 



Format: CALL STACK 



Function: 


Selects the alternate stacker on the IBM 1442, Model 6 or 7, only for the next 
card to go through the punch station. More detailed information may be found 
in the STACK flowchart and listing. 


Example: A card has been read. The sum of the four-digit numbers in columns 10-13 
and 20-23 is punched in columns 1-5. If the sum is negative, the card should be se- 
lected into the alternate stacker. A program to solve the problem follows: 




FORTRAN Statement 




Meaning 


1 


FORMAT(9X,I4,6X,I4) 




Description of the input data. 


2 


FORMAT(I5) 




Description of the output data. 




IO=2 




Input unit number. 


3 


READ(IO,l)Il,I2 




Input statement. 




13=11+12 




Sum. 




IF(I3)4,5,5 




Is the sum negative? 


4 


CALL STACK 




Yes — select the card. 


5 


WRITE (IO, 2)13 




No — punch. 




GO TO 3 




Process the next card. 




END 






Errors: 


None 






Remarks: 


If the card reader is in a not-ready 


state (last card) and the card just read is 
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to be stacker-selected, the card reader will not accept the stacker select command. The 
user should place a blank card after the card designating last card to his program. This 
will prevent the card reader from becoming not ready and will allow the card to be 
stacker-selected. 
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SUB 

Format : CALL SUB(JCARD,J,JLAST,KCARD,K,KLAST,NER) 

Function : Subtracts one arbitrary-length decimal data field from another arbitrary- 
length decimal data field, placing the result in the second data field. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the array that is subtracted, the subtrahend. The 
data must be stored in JCARD in decimal format, one digit per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first digit to be subtracted (the left-hand end of a 
field). 

JLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last digit to be 
subtracted (the right-hand end of a field). 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array, the minuend, is subtracted from, and will con- 
tain the result in decimal format, one digit per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first digit of KCARD (the left-hand end of the field). 

KLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to K. This is the position of the last character of 
KCARD (the right-hand end of a field). 

NER - An integer variable. Upon completion of the subroutine, this variable 
will indicate whether arithmetic overflow occurred. 

Detailed description: The sign of the JCARD field is reversed and then the JCARD and 
KCARD fields are ADDed using the ADD subroutine. More detailed information may be 
found in the SUB flowchart and listing. 
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Example: DIMENSION IGRND(12), ITEM(6) 

N=0 
CALL SUB(ITEM,1,6,IGRND,1,12,N) 



Before : 

IGRND 000713665203 



II 



Position 1 5 10 

N=0 



ITEM 102342 



Position 1 5 



After: 



IGRND 000713767545 
4 4 



ITEM is unchanged. 



Position 1 

N=0 



10 



The numeric data field ITEM, in decimal format, is SUBtracted from the numeric data 
field IGRND, also in decimal format. Note that the fields are both right-justified. In 
this case, since the ITEM field is negative, and the operation to be performed is sub- 
traction, the ITEM field is added to the IGRND field. The error indicator, N, is the 
same, since there is no overflow out of the high-order digit, left-hand end, of the 
IGRND field. 

Errors: If the KCARD field is not large enough to contain the sum (that is, if there is a 
carry out of the high-order digit), the error indicator, NER, will be set equal to KLAST. 

If the JCARD field is longer than the KCARD field, nothing will be done and the error 
indicator will be equal to KLAST. 

Remarks: See the remarks for the ADD subroutine. 
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S1403 



Format: CALL S1403(N) 

Function: Execute the requested control function on the IBM 1403 Printer, Model 6 or 
7, only. 

Parameter description: 

N - An integer constant, an integer expression, or an integer variable. The value 
of this variable corresponds to an available control function. 

Detailed description: If the printer is busy, the subroutine WAITs. Otherwise, or when 
the printer finishes, the routine executes the requested function and returns control to 
the calling program. The control functions and their values are as follows: 



Function 
Immediate skip to channel 1 
Immediate skip to channel 2 
Immediate skip to channel 3 
Immediate 6kip to channel 4 
Immediate skip to channel 5 
Immediate skip to channel 6 
Immediate skip to channel 7 
Immediate skip to channel 8 
Immediate skip to channel 9 
Immediate skip to channel 10 
Immediate skip to channel 11 
Immediate skip to channel 12 
Immediate space of 1 space 
Immediate space of 2 spaces 
Immediate space of 3 spaces 
Suppress space after printing 
Normal spacing is one space after printing. 



Value 
12544 
12800 
13056 
13312 
13568 
13824 
14080 
14336 
14592 
14848 
15104 
15360 
15616 
15872 
16128 
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Example: NUMBR=12544 

CALL S1403(NUMBR) 

The carriage skips until a punch in channel 1 of the carriage control tape is en- 
countered. (Normally this is at the top of a page. ) 



Errors: Only the codes mentioned above can be used. The use of anything else will re- 
sult in either no movement of the carriage or a WAIT at location 41 with 6xxl in the 
accumulator (hex). 

Remarks: When space suppression after printing is executed, it is reset to single-space 
after printing. If the user wishes to continue suppression, he must give the suppression 
command again. 

If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 

This CSP subroutine uses three subprograms that are part of the Disk Monitor Version 2 
subroutine library. If S1403 is to be used with Version 1 of the Monitor, ZIPCO, EBPT3, 
and PRNT3 must be loaded onto the Version 1 disk cartridge. 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER-*. 

UNPAC 

WHOLE 



TYPER 

Format : CALL TYPER(JCARD,J,JLAST) 

Function : The typing on the console printer is initiated, and control is returned to the 
user. 

Parameter description: 



JCARD - 



J - 



The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the characters to be printed on the con- 
sole printer, in Al format, one character per word. 

An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be printed (the left- 
hand end of a field). 



JLAST - An integer constant, an integer variable, or an integer expression, 

greater than or equal to J. This is the position of the last character of 
JCARD to be printed (the right-hand end of a field). 

Detailed description : The characters to be printed are converted from EBCDIC to con- 
sole printer codes and are packed. Since the characters are taken in pairs, an even 
number of characters is required. If necessary, the character at JCARD (JLAST+1) will 
be used to get an even number. Then the print operation is started. While printing is in 
progress, control is returned to the user's program. 

More detailed information may be found in the TYPER/KEYBD flowchart and listing. 



Example: DIMENSION IOTPT(120) 

CALL TYPER(IOTPT, 1,120) 



Before : 



IOTPT QUANTITY. . . ITEM. . . PRICE. . . AMOUNT 



Position 



20 



80 



120 



After: 

IOTPT is the same. The line is being printed. 

The printing of the line, specified in IOTPT, is initiated on the console printer, and con- 
trol returns to the user's program. 
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Errors: If a WAIT occurs at location 41, one of the following conditions exists: 

Condition Accumulator (hex) 

Console printer is not ready. 2xx0 

Make it ready and continue. 

Internal subroutine error. Re- 2xxl 

run job. If error persists, verify 

that the subroutine deck is accurate, 

using the listing in this manual. 

If the deck is the same, contact 

your local IBM representative. 

Save all output. 

If JLAST is less than J, two characters will be printed. If more than 120 characters are 
specified (JLAST- J+l is greater than 120), only 120 characters will be printed. 

Remarks : The asterisked characters in Appendix D of IBM 1130 Subroutine Library 
(C26-5925) are legal. No other characters will be printed. 

If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 

Control functions can be used on the console printer. The following table indicates the 
available control functions and the decimal constant required for each function: 

Function Decimal constant 

Tabulate 1344 

Shift to black 5184 

Carrier return 5440 

Backspace 5696 

Line feed 9536 

Shift to red 13632 

The decimal constant corresponding to a particular function must be placed in the output 
area (JCARD). The function will take place when its position in the output area is 
printed. 
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Example: 


JCARD(1)=5440 

JCARD(21)=1344 

JCARD(30)=5440 

JCARD(51)=5440 

JCARD(82)=5440 

CALL TYPER(JCARD,1 


,101) 








The above 


coding will carrier-return to 


a new line, 


then 


print characters 2-20 of JCARD, 


tab to the next tab stop; print characters 22-29, 


carrier 


return, print characters 31-50, 


carrier return, print characters 52-81, 


carrier 


return, 


and finally print characters 


83-101. 
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UNPAC 

Format : CALL UNPAC (JCARD, J, JLAST,KCARD,K) 

Function : Information in A2 format, two characters per word, is UNPACked into Al 
format, one character per word. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the input array, containing the data in A2 format, 
two characters per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of JCARD to be UNPACked (the left- 
hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable 

greater than or equal to J. This is the position of the last element of 
JCARD to be UNPACked (the right-hand end of a field). 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the array into which the data is UNPACked, in Al 
format, one character per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of KCARD to receive the UNPACked 
characters (the left-hand end of a field). 

Detailed description : The characters in the JCARD array (A2) are UNPACked left to 
right, starting with JCARD(J), and placed in the KCARD array (Al), starting with 
KCARD(K). Each element of JCARD, when UNPACked, will require two elements of 
KCARD. More detailed information may be found in the PACK/UNPAC flowchart and 
listing. 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICO MP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

-UNPAC 

WHOLE 
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Example: DIMENSION IUNPK(26),IPAKD(26) 

CALL UNPAC (IPAKD, 1,1 3, IUNPK, 1) 



Before: 



IPAKD THISblNFORMATIONbWILLbUNPACKEDbbbbbbbbbbbbbbbbbbbbbb 



Position 
IUNPK 

Position 



15 10 15 20 25 

FblbLbLbbblbNbbbTbHblbSbbbAbRbEbAbbbbbbbbbbbbbbbbbbb 



10 



15 



20 



25 



After: 



IPAKD is the same. 

IUNPK TbHblbSbbblbNbFbObRbMbAbTblbObNbbbWblbLbLbbbUbNbPbAb 



Position 15 10 15 20 25 

Note that each two characters shown above represent one element of the array. 



Errors : None 

Remarks : If JLAST is less than or equal to J, only the first element of JCARD,JCARD(J) 
will be UNPACked into the first two elements of KCARD. An even number of characters 
will always be UNPACked into KCARD. An equation for how much space is required, in 
elements, in KCARD is 

Space in KCARD = 2 (JLAST-J+1) 
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WHOLE 

Format : WHOLE (EXPRS) 

Function : Truncates the fractional portion of a real expression. 

Parameter description: 

EXPRS - A real expression. This is the expression that is truncated (the frac- 
tional part is made zero). 

Detailed description : The result of the expression is shifted right until the fractional 
portion has been shifted off. Then the result is shifted left to give the original result 
with a zero fraction. 



Example: 


A=WHOLE(.l*B+.5) 




Before: 


A=0.0 
B=71234.99 




After: 


A=7123. 000 
B=71234. 99 




The expression, 


(. 1*B+. 5), has been evaluated, 


and the fractional portion has been dropped. 

, 



Errors : None 

Remarks : The argument, EXPRS, must always be a real expression. If the purpose is 
to simply truncate the fraction from a number A, the expression must be (1. 0*A). 

If a single variable is used as an argument, the results of WHOLE are unpredictable. 
In other words, this will not work: 

A=WHOLE(B) 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

• WHOLE 
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Note that the WHOLE function truncates the value of the argument or expression within 
the parentheses; it does not round off before truncation. For this reason, the user must 
be careful when working with fractional numbers. For example, if 

X= 1570000. 

and 

Y= WHOLE (X* .001) 

Y will equal 1569. 000 rather than 1570. 000. This occurs because the multiplication by 
.001 yielded 1569.999 rattier than 1570.000. 

To avoid such a possibility, the argument for WHOLE should be half-adjusted by the user: 

Y = WHOLE (X*. 001-K). 5) 

before it is sent to WHOLE to be truncated. 
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SAMPLE PROBLEMS 

PROBLEM 1 

This program has been written to exercise many of the routines. A card is read and a 
code on that card initiates the operation of the specified routine. The card image is 
printed before execution of the routine, the resulting variable is printed and the card 
image is printed after execution of the routine. 

Switch settings are as follows: 



Input 
Device 


Output 
Device 


Switches 





1 


2 


1442 


console printer 


down 


down 


down 


1442 


1132 


up 


down 


down 


1442 


1403 


up 


up 


down 


2501 


console printer 


down 


down 


up 


2501 


1132 


up 


down 


up 


2501 


1403 


up 


up 


up 



Make sure that the switches are set properly before the program begins. 

After processing is completed, sample problem 1 will STOP with 1111 displayed in the 
accumulator. Press START to continue. 

A general purpose *IOCS card 

*IOCS(CARD, 1132 PRINTER, TYPEWRITER) 

has been supplied with the sample problem. If this does not match the 1130 configura- 
tion to be used, a new *IOCS card will be required. 
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Sample Problem 1: Source Program 



FOR CSP25940 

SAMPLE PROBLEM 1 CSP25950 

NAME SMPL1 CSP25960 

0CSICARD.1132 PRINTER. TYPEWR ITER) CSP25970 

ONE WORD 1NTEGI *S CSP25980 

EXTENDED PRECISION CSP25990 

LIST ALL CSP26000 

SENERAL PURPOSE 1130 COMMERCIAL SUBROUTINE PACKAGE TEST PROGRAM. CSP26010 

DIMENSION NCAR0I60I. NAMESI5.13I CSP26020 

FORMAT (80A1I CSP26030 

FORMAT I HO. 4F10.0, F10.3) CSP26040 
FORMAT (30H0N0W TESTING 1130 C5P ROUTINE .5A1.16M WITH PARAMETERS. CSP260S0 

X4F10.5. F10.3) CSP26060 

FORMAT I13H CARD BEFORE" .80A1 I CSP2607O 

FORMAT 113H CARD AFTER -.80A1) CSP2608O 

F0RMATI1H .5I3.2X.12HCAR0 AFTER -.1X.80A1I CSP26090 

FORMAT (1H0.4X.10HINDICATORS.3X.12HCARD BEFORE" .IX .80A1 ] CSP26100 

FORMAT (10H ANSWER IS. F20.3) CSP26110 

DEFINE UNIT NUMBERS OF I/O DEVICES. CSP26120 

CALL DATSWIO.NI CSP26130 

CALL DAT5W11.MI CSP26140 

CALL DATSW12.LI CSP26150 

NREAD-6»<1/LI»2 CSP26160 

NWRIT"Z»<1/NI+2»(1/MI+1 CSP26170 

READ (NREAD.ll NAMES CSP26180 

READ INREAD.2I N. Vli V2. V3> V4. VAR CSP26190 

IF (Nl 98.98.99 CSP26200 

STOP 1111 CSP26210 

WRITE (NWRIT.3I CIAMESiI.NI . 1-1.5). VI. V2. V3 . V4. VAR CSP26220 

Nl-Vl CSP26230 

N2-V2 CSP26240 

N3-V3 CSP26250 

N4-V4 CSP26260 

NVAR-VAR CSP26270 

NER1-0 CSP26280 

NER2-0 CSP26290 

NER3-0 CSP26300 

NER4-0 CSP26310 

NER5-0 CSP26320 

READ (NREAD.l) NCARD CSP26330 

IFIN-7) 21.21.22 C5P26340 

WRITEINWRIT.4) NCARD CSP26350 

GO TO 1130 CSP ROUTINE CSP26360 

GO TO 111. 12.13. 14. 15.16. 171 . N CSP26370 

COMP ROUTINE CSP26380 

ANS-NCOMP I NCARD. N1.N2. NCARD. N3) CSP26390 

GO TO 19 CSP26400 

MOVE ROUTINE CSP26410 

CALL M0VEINCARD.N1.N2.NCARD.N3) CSP26420 

GO TO 20 CSP26430 

NZONE ROUTINE CSP26440 

CALL N20NEINCARD.N1.N2.N3) CSP26450 

ANS-N3 CSP26460 

GO TO 19 CSP26470 

EDIT ROUTINE CSP26480 

CALL EDIT(NCARD.N1,N2, NCARD. N3.N4) CSP26490 
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SAMPLE PROBLEM 1 

00 TO 20 

c SET ROUTINE 

19 ANS-6ETINCARD.N1.N2.V3I 

GO TO 19 
c put ROUTINE 

16 CALL PUTINCARD.N1.N2.VAR.V3.N4) 
00 TO 20 

C FILL ROUTINE 

17 CALL FILLINCARD.N1.N2.NVARI 
00 TO 20 

19 WRITE (NWRIT.8) ANS 

20 WRITE (NWRIT.5I NCARD 
00 TO 10 

22 WRITE<NWRI».7> NCARD 
C A1DEC ROUTilE 

CALL A1DECINCARD.N1.N2.NER1I 
CALL A1DECINCARD.N3.N4.NER2I 
N-N-7 

SO TO (23.24.25,26,27.281 ,N 
C AOO ROUTINE 

23 CALL AD0INCARD.N1.N2. NCARD. N3.N4.NER3I 
00 TO 29 

C SUB ROUTINE 

24 CALL SUBINCARD.Nl.N2. NCARD. N3.N4.NER3) 
00 TO 29 

C MPY ROUTINE 

23 CALL MPYINCARD.Nl.N2. NCARD. N3.N4.NER3I 

00 TO 29 
C DIV ROUTINE 

26 CALL DIVINCARO.N1.N2.NCAR0.N3.N4.NER3I 
00 TO 29 

C ICOMP ROUTINE 

27 NER3« I COMPI NCARD. N1.N2. NCARD. N3.N41 
00 TO 29 

C NSION ROUTINE 

28 CALL NS1GN<NCARD.N1.NVAR.NER3I 
C DECA1 ROUTINE 

29 CALL DECAKNCARD.N1.N2.NER4) 
IFIN-3I 33.32.30 

30 IFIN-4I 33.31.33 

31 JSPAN-N2-N1 
KSPAN-N4-N3 
KSTRT-N3-JSPAN-1 
N3-N4-JSPAN 

CALL DECA1INCARD.KSTRT.N3-1.NER5I 
GO TO 33 

32 N3-N3-N2+N1-1 

33 CALL DECAKNCARD.N3.N4.NER5I 
WRITE(NWR]T.6I NER1.NER2 .NER3 .NER4.NER5. NCARD 
GO TO 10 

END 



PAGE 02 

CSP26500 
CSP26S10 
CSP26520 
CSP26530 
CSP26540 
CSP26330 
CSP26560 
C5P26570 
CSP26560 
CSP26590 
CSP26600 
CSP26610 
CSP26620 
CSP26630 
CSP26640 
CSP26650 
CSP26660 
CSP26670 
CSP26680 
CSP26690 
CSP26700 
CSP26710 
CSP26720 
C5P26730 
CSP26740 
CSP26750 
CSP26760 
CSP26770 
CSP26780 
CSP26790 
CSP26800 
CSP26810 
CSP26B20 
CSP26830 
CSP26840 
CSP26S50 
CSP26860 
CSP26870 
CSP26880 
CSP26890 
CSP26900 
CSP26910 
CSP26920 
CSP26930 
CSP26940 
C5P26950 
CSP26960 
CSP26970 
CSP26980 
CSP26990 
CSP27000 



VARIABLE ALLOCATIONS 
VI -0000 V2 "0003 
L ■00A8 NREAD-00A9 
NER2 -00B2 NER3 -00B3 

STATEMENT ALLOCATIONS 
1 -00C4 2 >00C7 
99 "018C 21 -01E8 
20 -0248 22 -0251 
31 -02C6 32 -02EE 



V3 >0006 V4 -0009 VAR -OOOC ANS -OOOF NCARD. 0064 NAMES-00A5 N -00A6 M -0OA7 
NWRIT-OOAA I -OOAB Nl -OOAC N2 -OOAD N3 -OOAE N4 -OOAF NVAR -0080 NER1 -OOBl 
NER4 -00B4 NER5 -0085 JSPAN-00B6 KSPAN-00B7 KSTRT.00B8 



3 


• OOCC 


4 


-OOEB 


5 


-00F6 


6 


• 0101 


7 


-0111 


8 


• 0126 


10 


-0177 


98 


-018A 


11 


-01FA 


12 


-0206 


13 


-020F 


14 


■021C 


15 


-0226 


16 


-0230 


17 


■ 023A 


19 


-0242 


23 


■0274 


24 


-027F 


25 


•028A 


26 


-0295 


27 


-02A0 


28 


-02AC 


29 


-02B2 


30 


-02C0 


33 


-02F8 































FEATURES SUPPORTED 
ONE WORD INTEGERS 
EXTENOEO PRECISION 
IOCS 



CALLED SUBPROGRAMS 
DATSW NCOMP MOVE 
DECA1 ELD ESTO 
STOP CARD2 PRNTZ 

INTEGER CONSTANTS 

0-OOBA 1-OOBB 



NZONE EDIT 
IFIX FLOAT 


GET 
WRTYZ 


PUT FILL 
SRED SWRT 


A1DEC 

SCOMP 


ADD SUB 
SFIO SIOAI 


MPY 

SIOIX 


OIV ICOMP NSIGN 
SIOF SIOI SUBSt 


2-OOBC 


6-00BD 


Ull-OOBE 


5-OOBF 


T-OOCO 


3-00C1 


4-00C2 4369-00C3 



CORE REQUIREMENTS FOR SMPL1 
COMMON VARIABLES 



186 PROGRAM 



END OF COMPILATION 
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Sample Problem 1: Output 



NOW TESTING 1130 CSP ROUTINE NCOMP 
CARD BEFORE'ABCDEFGHIJKLMNOPQRST 
ANSWER IS -272.000 
CARD AFTER -ABCDEFGH1JKLMNOPQRST 


WITH 


PARAMETERS 


1.00000 


10. 


.coooo 


11.00000 


0.00000 
2CSP27040 

2CSP27040 


NOW TESTING 1130 
CARD BEF0RE-BC80 
ANSWER IS 
CARD AFTER -BC8D 


CSP 

F 

F 


ROUTINE NCOMP 
BCBD F 

0.000 
BCBD F 


WITH 


PARAMETERS 


1.00000 


10. 


,00000 


11.00000 


0.00000 
4CSP27060 

4CSP27060 


NOW TESTINS 1130 
CARD BEFORE' 
ANSWER IS 
CARD AFTER - 


CSP 


ROUTINE NCOMP WITH 
JKLMN 
224.000 

JKLMN 


PARAMETERS 
CBAFG 

CBAFG 


20.00000 


25. 


.00000 


30.00000 


0.00000 
6CSP27080 

6CSP27080 


NOW TESTING 1130 CSP 
CARD BEFORE-ABCDE 
CARD AFTER -A8CDL 


ROUTINE MOVE WITH 
ABCOE 


PARAMETERS 


1.00000 


5. 


.00000 


20.00000 


0.00000 

8CSP27100 

8CSP27100 


NOW TESTINS 1130 CSP ROUTINE MOVE 

CARD BEFORE' 

CARD AFTER .9376943210 


WITH 


PARAMETERS 


40.00000 
9876543210 
9B76543210 


49,00000 


1.00000 


0.00000 
10CSP27120 
10CSP27120 


NOW TESTINO 1130 
CARD BEFORE. 
ANSWER IS 
CARD AFTER • 


CSP 


ROUTINE NZONE 
A 

1.000 
A 


WITH 


PARAMETERS 


10.00000 


3.00000 


0.00000 


0.00000 
12CSP27140 

12CSP27140 


NOW TESTINO 1130 
CARD BEFORE. 
ANSWER IS 
CARD AFTER • 


CSP 


ROUTINE NZONE 
I 

1.000 

I 


WITH 


PARAMETERS 


10.00000 


5, 


,00000 


0.00000 


0.00000 
14CSP27160 

14CSP27160 


NOW TESTING 1130 
CARD BEFORE' 
ANSWER IS 
CARD AFTER « 


CSP 


ROUTINE NZONE 

4.000 




WITH 


PARAMETERS 


20.00000 


5. 


.00000 


0.00000 


0.00000 
16CSP271SO 

16CSP27180 


NOW TESTING 1130 
CARD BEFORE. 
ANSWER IS 
CARD AFTER - 


CSP 


ROUTINE NZONE 
9 
4.000 

9 


WITH 


PARAMETERS 


20.00000 


i, 


.00000 


0.00000 


0.00000 
18CSP27200 

18CSP272O0 


NOW TESTING 1130 
CARD BEFORE' 
ANSWER IS 
CARD AFTER • 


CSP 


ROUTINE NZONE 
2.000 


WITH 


PARAMETERS 
J 

J 


30.00000 


5, 


,00000 


0.00000 


0.00000 
20CSP27220 

20CSP27220 


NOW TESTING 1130 
CARD BEFORE- 
ANSWER IS 
CARD AFTER • 


CSP 


ROUTINE NZONE 
2.000 


WITH 


PARAMETERS 

R 

R 


30.00000 


5, 


,00000 


0.00000 


0.00000 
22CSP27240 

22CSP27240 


NOW TESTING 1130 
CARD BEFORE' 
ANSWER IS 


CSP 


ROUTINE NZONE 
A 

1.000 


WITH 


PARAMETERS 


10.00000 


1 


,00000 


0.00000 


0.00000 
24CSP27260 
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CARD AFTER -1234567 



NOW TESTING 
CARD BEFORE: 
CARD AFTER • 

NOW TESTING 
CARD BEFORE 
CARD AFTER 

NOW TESTING 
CARD BEFORE 
ANSWER IS 
CARD AFTER ■ 

NOW TESTING 
CARD BEFORE- 
ANSWER IS 
CARD AFTER . 

NOW TESTING 
CARD BEFORE- 
ANSWER IS 
CARD AFTER - 

NOW TESTING 
CARD BEFORE- 
ANSWER IS 
CARD AFTER • 

NOW TESTING 
CARD BEFORE- 
ANSWER IS 
CARD AFTER ■ 

NOW TESTING 
CARD BEFORE. 
ANSWER IS 
CARD AFTER • 

NOW TESTING 
CARD BEFORE' 

CARD AFTER ■ 

NOW TESTING 
CARD BEFORE' 
CARO AFTER ■ 

NOW TESTING 
CARD BEFORE' 
CARD AFTER . 

NOW TESTING 
CARD BEFORE- 
CARD AFTER ■ 

NOW TESTING 



1.00000 6.00000 10.00000 



1.00000 6.00000 20.00000 



5.00000 0.01000 



1.00000 7.00000 0.00100 



1130 CSP ROUTINE EDIT WITH PARAMETERS 
•00005M i* • CR 

■00005M *ft##tt#**##««**00.54CR 

1130 CSP ROUTINE EDIT WITH PARAMETERS 
5M .0 . - 

5M .54- 

1130 CSP ROUTINE GET WITH PARAMETERS 
■12345 

123.449 
'12345 

1130 CSP ROUTINE GET WITH PARAMETERS 
•1234N 

-123.449 
-1234N 

1130 CSP ROUTINE GET WITH PARAMETERS 
■13 5 7 

1010.506 
■ 13 5 7 

1130 CSP ROUTINE GET WITH PARAMETERS 
12A84 

0.000 
12AB4 

1130 CSP ROUTINE GET WITH PARAMETERS 
1230- 

-12300.000 
1230- 

1130 CSP ROUTINE GET WITH PARAMETERS 1.00000 3.00000 O.OOCOl 
123 

0.001 
123 

1130 CSP ROUTINE PUT WITH PARAMETERS 1.00000 5.00000 0.50000 

12345 

1130 CSP ROUTINE PUT WITH PARAMETERS 1.00000 2.00000 5.00000 

89 

1130 CSP ROUTINE PUT WITH PARAMETERS 11.00000 15.00000 5.00000 

01235 

1130 CSP ROUTINE PUT WITH PARAMETERS 10.00000 16.00000 50.00000 

0000340 

1130 CSP ROUTINE PUT WITH PARAMETERS 10.00000 17.00000 5.00000 



1.00000 5.00000 



30.00000 0.000 

50CSP27520 

50CSP27320 

29.00000 0.000 

52CSP27540 

52CSP27540 

0.00000 0.000 
54CSP27560 

54CSP27560 

0.00000 0.000 
56CSP27380 

56CSP275B0 

0.00000 0.000 
58CSP27600 

56CSP27600 

0.00000 0.000 
60CSP27620 

60CSP27620 

0.03000 0.000 
62CSP27640 

62CSP27640 

0.00000 0.000 
64CSP27660 

64CSP27660 

0.00000 12345.000 
66CSP276S0 
66CSP27680 

1.00000 12890.000 
68CSP27700 
68CSP27700 

1.00000 12345.000 
70CSP27720 
70CSP27720 

2.O0OO0-34567.O00 
72CSP27740 
72CSP27740 



CARD AFTER - 




A 










24CSP27260 


NOW TESTING 1130 
CARD BEFORE- 
ANSWER IS 
CARD AFTER - 


CSP 


ROUTINE NZONE 
1 

4.000 
A 


WITH PARAMETERS 


10.00000 


l.OCOOO 


0.00000 


0.00000 
26CSP27280 

26CSP27280 


NOW TESTING 1130 
CARD BEFORE- 
ANSWER IS 
CARD AFTER • 


CSP 


ROUTINE NZONE 
J 

2.000 
A 


WITH PARAMETERS 


10.00000 


1.00000 


0.00000 


0.00000 
ZBCSP27300 

28CSP27300 


NOW TESTING 1130 
CARD BEFORE- 
ANSWER IS 
CARD AFTER ■ 


CSP 


ROUTINE N20NE 
I 
1.000 

9 


WITH PARAMETERS 


20.00000 


4.00000 


0. 00000 


0.00000 
30CSP27320 

30CSP27320 


NOW TESTING 1130 
CARD BEFORE" 
ANSWER IS 
CARD AFTER - 


CSP 


ROUTINE N20NE 
9 
4.000 

R 


WITH PARAMETERS 


20.00000 


2.00000 


0.00000 


0.00000 
32CSP27340 

32CSP27340 


NOW TESTING 1130 
CARD BEFORE- 
ANSWER IS 
CARO AFTER - 


CSP 


ROUTINE NZONE 
R 
2.000 

Z 


WITH PARAMETERS 


20.00000 


3.00000 


0.00000 


0.00000 
34CSP27360 

34CSP27360 


NOW TESTING 1130 
CARD BEFORE- 
ANSWER IS 
CARD AFTER ■ 


CSP 


ROUTINE NZONE 
1.000 


WITH PARAMETERS 


U 


30.00000 


3.00000 


0.00000 


0.00000 
36CSP27380 

36CSP27380 


NOW TESTING 1130 
CARD BEFORE- 
ANSWER IS 
CARD AFTER - 


CSP 


ROUTINE NZONE 
4.000 


WITH PARAMETERS 
4 

M 


30.00000 


2.00000 


0.00000 


0.00000 
38CSP27400 

38CSP27400 


NOW TESTING 1130 
CARD BEFORE- 
ANSWER IS 
CARD AFTER - 


CSP 


ROUTINE NZONE 
2.000 


WITH PARAMETERS 

M 

4 


30.00000 


4.00000 


0.00000 


0.00000 
40CSP27420 

40CSP27420 


-NOW TESTING 1130 CSP 
CARD BEFORE-123436 
CARD AFTER -123456 


ROUTINE EDIT 
t 
SI. 


WITH PARAMETERS 
I. CR 
234.56 


1.00000 


6.00000 


20.00000 


30.00000 

42CSP27440 

42CSP27440 


NOW TESTING 1130 CSP 
CARD BEFORE-02343K 
CARD AFTER -02343K 


ROUTINE EDIT WITH PARAMETERS 
• S. CR 
S234.32CR 


1.00000 


6.00000 


20.00000 


30.00000 

44CSP27460 

44CSP27460 


NOW TESTING 1130 CSP 
CARD BEFORE-00343- 
CARD AFTER -00343- 


ROUTINE EDIT 


WITH PARAMETERS 
S. - 

$34.30- 


1.00000 


6.00000 


20.00000 


29.00000 

46CSP27480 

46CSP27480 


NOW TESTING 1130 CSP 
CARD BEFORE-1234567 


ROUTINE EDIT 
i 


WITH PARAMETERS 
S. 


1.00000 


7.00000 


21.00000 


28.00000 
48CSP27500 



-97- 



-ARC BEFORE' 

CARD AFTER ■ OOOOOOOK 

NOW TESTING 1130 CSP ROUTINE FILL WITH PARAMETERS 
CARD BEFORE-ABCOEFGHIJK 
CARD AFTER ■ K 

NOW TESTING 1130 CSP ROUTINE FILL WITH PARAMETERS 
CARD BEFORE- ABCDEFGH 

CARD AFTER - ASSSSSSH 



1.00000 10.00000 



20.00000 25.00000 0.00000 



74CSP27760 
74CSP27760 

0.00000 164411.000 
76CSP27780 
76CSP277B0 

0.00000 23360.000 
78CSP27B00 
78CSP27800 



NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 
0-600 



CARD BEFORE 
CARD A C TER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 
10 



CARD BEFORE: 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 
6 



CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 
0-900 



CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 
10 



CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BTFORE 
CARD AFTER 



NOW TESTING U30 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 
0-100 



CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 
10 



CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 




CARD BEFORE 
CARD AFTER 



24 
00024 

SUB WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 

24 
00024 

MPY WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 

24 
00024 

DIV WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 

24 
00024 

ICOMP WITH PARAMETERS 31.00000 35.00000 66.00000 70. 00000 

24 
00024 



2046 
02072 



2046 
02024 



2048 
0000048*92 



2048 
OOO8500OO8 



2048 
02048 



NSIGN WITH PARAMETERS 



1.00000 2.00000 2.00000 



ADD WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 



SUB WITH PARAMETERS 



00099 
31.00000 35.00000 66.00000 



99 
00099 



2048 
02147 



2048 
01949 



MPY WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 

99 

00099 

DIV WITH PARAMETERS 31.00000 35.C0000 66.00000 70.00000 



2048 
0000202392 



99 2048 

00099 0002000068 

ICOMP WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 0.000 

99 

00099 



2048 

02048 



NSIGN WITH PARAMETERS 
54 



1.00000 2.00000 2.00000 



ADO WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



12345676901234567890 
12345678901234567990 



123456799012 345678901234567890 
123456799024691357802469135780 



SUB WITH PARAMETERS 1.00000 20,00000 41.00000 70.00000 



12345679901234567990 
12345679901234567890 



123456789012 343678901234567890 
12 34567890O0000000OJ0O000J000O 



MPY WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



12345679901234567890 



123456769012345678901234567890 



12345679901234567890012345679081234567906123456791 11 111101 11 1111110100 

DIV WITH PARAMETERS 1.00000 20.00000 41.1)0000 70.00000 0.000 

12343678901234567990 12345676901234567690123456 7890 

123456789012345678900000000000000000000100000000000000000000123456 7890 

ICOMP WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 



12345678901234567890 
12345679901234567990 



12345679901234567890123456 7890 
123456789012345678901234567890 



NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.000UO 

32 

L2 

ADO WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



1234567890123456789- 
1234567890123456789- 



123456789012345678901234567890 
123456 78900000000000 OOOOOOOOOO 



SUB WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



1234567890123436789- 
1234567890123456789- 



123456789012345678901234567890 
12345678902469135780246913 5 790 



MPY WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



1234567890123456789- 



12345679901234567890123456 7890 



1234567890123456789-01234567908123456790812345679111 111 10111111 11 1010- 

DIV WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 

1234567890123456789- 123456789012345678901234567890 

12345678901 234 56789-0000000000000000000 1000000000-0000000000 12 3456 78 90 



CSP27820 
CSP27820 



CSP27840 
CSP27S4U 



CSP27860 

CSP27860 



CSP27880 
CSP27S80 



CSP27900 
CSP27V00 



CSP27920 
CSP27920 



CSP27940 

CSP27V40 



CSP27960 
CSP27960 



CSP27980 
CSP27980 



CSP28000 

CSP2800O 



CSP28020 
CSP28020 



CSP28040 
CSP28040 



CSP28060 
CSP28060 



CSP28080 
CSP28080 



CSP2810J 
CSP28100 



CSP28120 
CSP28120 



CSP2 8140 
CSP28140 



CSP28160 
CSP26160 



CSP28180 
CSP28180 



CSP28200 
CSP29200 



CSP28220 
CSP28220 



CSP28240 
CSP28240 



NOW TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



-98- 



INDICATORS 
0-1 



CARD BEFORE- 
CARD AFTER ■ 



12343*7890123436789- 
1234567890123436789- 



NOW TESTING 1130 CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 



123436789012345678901234567690 
123456789012343678901234567890 

1.000 



INDICATORS 
0-100 



CARD BEFORE" 
CARD AFTER ■ 



ON 
6N 



CSP28260 
CSP28260 



CSP28280 
CSP28280 



NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 



INDICATORS 




CARD BEFORE' 
CARD AFTER • 



12345678901234567890 
12345678901234567890 



NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



12345678901234567890123456789- 
123456769000000000000000000UO- 

0.000 



INDICATORS 




CARD BEFORE' 
CARD AFTER ' 



12343678901234367890 
12345678901234567890 



12345678901234567890123456789- 
12345678902469135780246913578- 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 

12345678901234567690123456789- 



INDICATORS 




CARD BEFORE. 
CARD AFTER ■ 



12343678901234567890 



12343678901234 567890 i»»3oio»uk^>u'b7 U «--.«,.. 

1234567890123456789001234567908 12343679081234567911111 110111111 1U010- 

NOW TESTING 1130 CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 



INDICATORS 




CARD BEFORE' 
CARD AFTER . 



12345678901234567890 12345678901234567890123456789- 

1234567890 123456789000000000000000000001000000000-0000000000123456769- 



NOW TESTING 1130 CSP ROUTINE I COMP WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 



INDICATORS 




CARD BEFORE' 
CARD AFTER ' 



NOW TESTING 1130 CSP ROUTINE 



INDICATORS 
0-100 



CARD BEFORE 
CARD AFTER 



■ 12345678901234567890 
• 12345678901234567890 

NSIGN WITH PARAMETERS 

. NM 



123456769012 34567890123456789- 
12345678901234567890123456789- 



CSP28300 
CSP2S300 



CSP28320 
CSP28320 



CSP28340 
CSP28340 



CSP28360 
CSP28360 



CSP28380 
CSP28380 



1.00000 1.00000 2.00000 2.00000 



-1.000 



CSP28400 
CSP28400 



NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 



INDICATORS 




CARD BEFORE' 
CARD AFTER ' 



1234567890123456769- 
1234567890123456789- 



NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



12345678901234567890123456789- 
1234567890246913578024691357B- 

0.000 



INDICATORS 




CARD BEFORE' 
CARD AFTER ' 



1234567890123456789- 
1234367890123456789- 



12345678901234567890123456769- 
12345678900000000000000000000- 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 

12345678901234567890123456789- 



INDICATORS 


NOW TESTING 1130 

INDICATORS 



CARD BEFORE' 
CARD AFTER ' 

CSP ROUTINE 

CARD BEFORE 



' 1234567890123456789- A*3430 lavui* J«o 'o* u.«--'v - w *- 

' 1234567890123456769-0123456790812345679081234567911111 11011 1111 11 10100 

DIV WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 

, 1234567890123456789- 12345678901234567890123456789- 



CSP28420 
CSP26420 



CSP28440 
CSP28440 



CSP28460 
CSP28460 



CARD AFTER 

NOW TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 

INDICATORS CARD BEFORE- 1234567690123456789- 
CARD AFTER « 1234567890123456789- 

NOW TESTING 1130 CSP ROUTINE hSIGN WITH PARAMETERS 



1234567890123456789-0000000000000000000100000000000000000000123456789- 
1.00000 20.00000 41.00000 70.00000 0.000 



12345678901234567890123456789- 
12345678901234567890123456789- 



1.00000 1.00000 2.00000 2.00000 



INDICATORS 
0-100 



CARD BEFORE" ML 
CARD AFTER " 4L 



CSP28S00 
CSP28500 



CSP28520 
CSP28520 



NOW TESTING 1130 CSP ROUTINE ADD 
INDICATORS 



WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 




NOW TESTING 1130 CSP ROUTINE SUB 
INDICATORS 



CARD BEFORE" 12345678901234567690 
CARD AFTER - 1234367B901234567890 



12343678901234567890 
24691357802459135780 



WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 




NOW TESTING 1130 CSP ROUTINE MPY 
INDICATORS 



CARD BEFORE" 12345678901234367890 
CARD AFTER ■ 12345678901234567890 



12345678901234567890 

ooooooooooooooouoooo 



WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



CARD BEFORE" 12345676901234567890 
CARD AFTER - 12345678901234567890 





NOW TESTING 1130 CSP ROUTINE DIV 

INDICATORS CARD BEFORE- 12345678901234567890 
CARD AFTER " 12345678901234567890 

NOW TESTING 1130 CSP ROUTINE JCOMP WITH PARAMETERS 

INDICATORS CARD BEFORE" 12343678901234567890 
CARD AFTER - 12345678901234567890 

NOW TESTING 1130 CSP ROUTINE NSIGN WITH PARAMETERS 

INDICATORS CARD BEFORE- -0 
0-100 CARD AFTER • 00 

NOW TESTING 1130 CSP ROUTINE ADD 

INDICATORS 



12345678901234567890 
0123456790812345679111111101111111110100 



CSP28540 
CSP28540 



CSP28560 
CSP2B560 



CSP28580 
CSP28580 



WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



12345678901234567890 
OOOOOOOOOOOOOOOOOOOIOOOOOOOOOOOOOOOOOOOO 

1.00000 20.00000 51.00000 70.00000 0.000 

12345678901234567890 
12345678901234567890 

1.00000 1.00000 2.00000 2.00000 1.000 



CSP28600 
CSP28600 



WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 




NOW TESTING 1130 CSP ROUTINE SUB 



CARD BEFORE" 1234367890123456789- 
CARD AFTER ■ 1234567890123456789- 



12345678901234567890 

oooooooooooooooooooo 



WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS 




CARD BEFORE- 1234567890123456789- 
CARD AFTER - 1234567690123436769- 



12345678901234567890 
24691357802469135780 



NOW TESTING 1130 CSP ROUTINE MPY 
INDICATORS 



WITH PARAMETERS 1.00000 20.00000 31.00000 70.00000 



CARD BEFORE- 1234567890123456789- 
CARD AFTER ■ 1234567890123436789- 



12345678901234567890 
012345679081234567911111110111111111010- 



CSP28620 
CSP28620 



CSP28640 
CSP2S640 



CSP28660 
CSP28660 



CSP28680 

CSP28680 



CSP28700 
CSP28700 



-99- 



NOW TEST 1-16 1130 CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS CARD BEFORE. 1234567890123456789- 
CARD AFTER . 1234567890123456769- 



12345676901234567890 

00000000O0000000OO0JOOO0000Q0OOO0000000O 



NOW TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS CARD BEFORE- 1234567890123436789- 
0»«« CARD AFTER • 1234567890123456789- 



12345678901234567890 
12345678901234567690 



NOW TESTING 1130 CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 



INDICATORS CARD BEFORE- -0 
0-100 CARD AFTER • -0 



NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 



INDICATORS CARD BEFORE- 12345678901234567890 
CARD AFTER » 12345678901234567890 



1234567690123456789- 
0000000000000000000- 



CSP28720 
CSP28720 



CSP28740 
CSP28740 



CSP28760 
CSP28760 



CSP28780 

CSP28780 



NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 



INDICATORS CARD BEFORE- 12343678901234567890 
CARD AFTER - 12345676901234567890 



1234367890123456789- 
2469135780246913578- 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 



INDICATORS CARD BEFORE- 12345678901234567890 
CARD AFTER - 12345678901234567890 



1234567890123456789- 
012345679061234567911111110111111111010- 



NOW TESTING 1130 CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 



INDICATORS CARD BEFORE. 12345676901234567690 
CARD AFTER - 12345676901234567890 



1234367690123456789- 

OOOOOOOOOOOOUOOOOOOJOOOOOOOOOOOOOOOOOOO- 



NOW TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 



INDICATORS CARD BEFORE- 12345678901234567890 
0»»* CARD AFTER - 12345678901234567890 



1234567690123456789- 
1234567890123456789- 



NOW TESTING 1130 CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 0.000 



INDICATORS CARD BEFORE- -0 
0-100 CARD A r TER • 00 



NOW TESTING 1130 CSP ROUTINE ADO WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 

1234567690123456789- 
2469135780246913578- 

1.00000 20.00000 51.00000 70.00000 0.000 
1234567890123456789- 

oooooooooooouoooooo- 

1.00000 20.00000 51.00000 70.00000 o.ooo 



INDICATORS CARD BEFORE- 1234567890123456789- 
CARD AFTER ■ 1234567890123456789- 

NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 

INDICATORS CARD BEFORE- 1234567690123456769- 
CARD AFTER - 1234567690123456789- 

NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 



CSP28800 
CSP28800 



CSP2B620 
CSP28820 



CSP28640 
CSP28840 



CSP28860 
CSP28860 



csPzssao 

CSP28880 



CSP2S900 
CSP2S900 



CSP28920 
CSP28920 



INDICATORS CARD BEFORE- 1234567690123456789- 
CARD AFTER - 1234567690123456789- 



1234567890123456769- CSP2S940 
0123456790812345679111111101111111110100 CSP28940 



NOW TESTING 1130 CSP R0uT!NE DIV WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS CARD BEFORE- 1234567890123456769- 
CARD AFTER . 1234567890123456769- 



1234567890123456789- CSP28960 
OOOOOOOOOOOOOOOOUOOIOJOOOOOOOOOOOOOOOOO- CSP28960 



NOW TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS 




CARD BEFORE- 1234567890123456789- 
CARD AFTER - 1234567890123456789- 



1234567890123456789- CSP28980 
1234567890123456789- CSP28980 



-100- 



Sample Problem 1: Data Input Listing 



// XEQ 

NCOMPMOVE NZONEEDIT GET 

1 1 

ABCDEFGMIJKLMNOPQRST 

1 1 

BC8D F BC8D F 



FILL ADD SUB 
11 



MPY D1V ICOMPNSIGN 



20 

JKLMN 
1 

40 

10 

10 

20 


20 

9 
30 

30 

10 

10 

10 

20 

I 
20 

9 
20 

R 
30 

30 

30 



123456 
02343K 
00343- 
1234967 
00005M 
5M 
12345 
1234N 
13 5 7 



>» 
tO 



25 

CBAFG 
5 

49 

5 



M 

6 
CR 

6 
CR 

6 



6 

CR 

6 

5 

5 



11 

30 

20 

1 
9876543210 



20 

20 

20 

21 

10 

20 

.01 

.01 

.001 



30 
30 
29 
28 
30 
29 



CSP27010 
CSP27020 
1CSP27030 
2CSP27040 
3CSP27050 
4CSP27060 
5CSP27070 
6CSP27080 
7CSP27090 
8CSP27100 
9CSP27110 
10CSP27120 
UCSP27130 
12CSP27140 
13CSP27150 
14C6P27160 
15CSP27170 
16CSP27180 
17CSP27190 
18CSP27200 
19CSP27210 
20CSP27220 
21CSP27230 
22CSP27240 
23CSP27250 
24CSP27260 
25CSP27270 
26CSP27280 
27CSP27290 
28CSP27300 
29CSP27310 
30CSP27320 
31CSP27330 
32CSP27340 
33CSP27350 
34CSP27360 
35CSP27370 
36CSP273BO 
37CSP27390 
38CSP27400 
39CSP27410 
40CSP27420 
41CSP27430 
42CSP27440 
43CSP27450 
44CSP27460 
45C5P27470 
46CSP27480 
47CSP27490 
48CSP27900 
49CSP27510 
50CSP27520 
51CSP27530 
52CSP27540 
53CSP27550 
54CSP27560 
55CSP27570 
56CSP27580 
57CSP27590 
58CSP27600 



-101- 



s 




5 




1. 








59CSP27610 


12AB4 
















60CSP27620 


5 




5 




1. 








61CSP27630 


12 30- 
















62CSP27640 


5 




3 


.ooooi 








63CSP27650 


12 3 
















64CSP27660 


6 




5 




0.5 





12345. 




65CSP27670 
66CSP27680 


6 




2 




5.0 


1 


12890. 




67CSP27690 
6SCSP27700 


6 


11 


15 




5.0 


1 


123*5. 




69CSP27710 
70CSP27720 


6 


10 


16 




50.0 


2 


-3*567. 




71CSP27730 
72CSP27740 


6 


10 


17 




5.0 


1 


-16. 




73CSP27750 
74CSP27760 


7 


1 


10 








164*8. 




75CSP27770 


ABCDEFGHIJK 
















76CSP27780 


7 


20 

ABCOEFOH 


25 








23.360. 




77CSP27790 
78CSP27600 


08 


31 


35 


2* 


66 


70 




20*8 


CSP27810 
CSP27620 


OS 


31 


35 


2* 


66 


70 




2048 


CSP27830 
CSP27840 


10 


31 


35 


2* 


66 


70 




20*8 


CSP27850 
CSP27860 


u 


31 


35 


2* 


66 


70 




2048 


CSP27870 
CSP27880 


12 


31 


35 


2* 


66 


70 




20*8 


C5P27890 
CSP27900 


13 


1 


1 




2 


2 


1. 




CSP27910 


65 
















C5P27920 


08 


31 


35 


99 


66 


70 




2046 


CSP27930 
CSP27940 


09 


31 


35 


99 


66 


70 




20*8 


CSP27950 
CSP27960 


10 


31 


35 


99 


66 


70 




2046 


CSP27970 
CSP27960 


11 


31 


35 


99 


66 


70 




20*8 


CSP27990 
CSP28000 


12 


31 


35 


99 


66 


70 




20*8 


CSP28010 
CSP28020 


13 


1 


1 




2 


2 


-1. 




CSP28030 


54 
















CSP28040 


08 


01 


20 




*1 


70 






CSP28050 


12 3*567890123*567890 






1234 5678901234567890123*567890 


CSP28060 


09 


01 


20 




41 


70 






C5P28070 


1234567890123*567890 






123*567890123*567890123*567890 


CSP28080 


10 


01 


20 




41 


70 






CSP28090 


123*567890123*567890 






12 3*567890123*56789012 34567890 


CSP28100 


11 


01 


20 




41 


70 






CSP28110 


123*567890123*567890 






123456769012 3456789012 34567 890 


CSP28120 


12 


01 


20 




41 


70 






CSP28130 


123*567890123*567890 






123*567890123*5678901234567890 


CSP28140 


13 


1 


1 




2 


2 






CSP28150 


32 
















CSP28160 


08 


01 


20 




41 


70 






CSP28170 
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1234567890123456789- 






123456789012345678901234567890 


CSP28160 


09 01 


20 


4l' 


70 


CSP26190 


1234567890123456789- 






123456789012345678901234567890 


CSP26200 


10 01 


20 


41 


70 


CSP2B210 


1234567890123456789- 






123456789012345678901234567890 


CSP28220 


11 01 


20 


41 


70 


CSP28230 


12 34567890123456789- 






123456789012345678901234567890 


CSP28240 


12 01 


20 


41 


70 


CSP28250 


1234567890123456789- 






123456789012345676901234567890 


CSP28260 


13 1 


1 


2 


2 1. 


CSP28270 


ON 








CSP28280 


06 01 


20 


41 


70 


CSP28290 


12 345678901234967890 






12345676901234567890123436789- 


CSP26300 


09 01 


20 


41 


70 


CSP28310 


12345678901234567890 






12345678901234567890123456789- 


CSP28320 


10 01 


20 


41 


70 


CSP28330 


12345678901234567890 






12345678901234567890123456789- 


CSP28340 


11 01 


20 


41 


70 


CSP28350 


12345678901234567890 






12345678901234567890123456789- 


CSP28360 


12 01 


20 


41 


70 


CSP26370 


12345678901234567890 






12345676901234567890123456789- 


CSP26380 


13 1 


1 


2 


2 -1. 


CSP28390 


NM 








CSP28400 


08 01 


20 


41 


70 


CSP28410 


12 34567890123456789- 






12345678901234567890123456789- 


CSP28420 


09 01 


20 


41 


70 


CSP28430 


12 3456 7890123456789- 






1234567890123456769012 3456789- 


CSP28440 


10 01 


20 


41 


70 


CSP28450 


1234567890123456789- 






12345678901234567890123456789- 


CSP28460 


11 01 


20 


41 


70 


CSP28470 


1234567890123456789- 






12345676901234567690123456789- 


CSP28480 


12 01 


20 


41 


70 


CSP28490 


1234567890123456789- 






12345578901234567690123456789- 


CSP28500 


13 1 


1 


2 


2 


CSP28510 


ML 








CSP28520 


OS 01 


20 


51 


70 


CSP28530 


12345678901234567890 






12345678901234567890 


CSP28540 


09 01 


20 


51 


70 


CSP28550 


12345678901234567890 






12345678901234567890 


CSP28560 


10 01 


20 


51 


70 


CSP26570 


12345678901234567890 






12345676901234567890 


CSP28580 


11 01 


20 


51 


70 


CSP28590 


12345678901234567890 






12345678901234567890 


CSP28600 


12 01 


20 


51 


70 


CSP28610 


12 345678901234567890 






123456789012 34567890 


CSP28620 


13 1 


1 


2 


2 i. 


CSP28630 


-0 








CSP28640 


08 01 


20 


51 


70 


CSP28650 


1234567890123456''e9- 






12345678901234567890 


CSP28660 


09 01 


20 


51 


70 


CSP28670 


12 34367690123456789- 






12345678901234567890 


CSP28680 


10 01 


20 


51 


70 


CSP28690 


12 34367890123456789- 






1234567S901234567890 


CSP28700 


11 01 


20 


51 


70 


CSP28710 


12 34567890123436789- 






12345678901234567890 


CSP28720 


12 01 


20 


51 


70 


CSP28730 


1234967890123456789- 






12345678901234567890 


CSP28740 


13 1 


1 


2 


2 -1. 


CSP28750 


-0 








CSP28760 


OS 01 


20 


51 


70 


CSP26770 


12343678901234567890 






1234567890123456789- 


CSP28760 



09 01 
12345678901234567890 

10 01 
12345678901234567890 

11 01 
12345678901234567890 

12 01 
12345678901234567890 

13 1 
-0 

06 01 
1234567890123456789- 

09 01 
1234567890123456789- 

10 01 
1234567890123496789- 

11 01 
12 34567890123456789- 

12 01 
1234567890123456789- 



20 


51 


70 


20 


51 


70 


20 


51 


70 


20 


51 


70 


1 


2 


2 


20 


51 


70 


20 


51 


70 


20 


51 


70 


20 


51 


70 


20 


51 


70 



1234567890123456789- 
1234567890123456789- 



1234567690123456789- 
1234567890123456789- 



1234567690123456789- 
1234567890123456789- 



1234567890123496789- 
123456789012 3456789- 



1234567890123456789- 



CSP28790 
CSP2S800 
CSP28610 
CSP28820 
CSP28S30 
CSP28840 
CSP28850 
CSP28860 
CSP2S870 
CSP28680 
CSP28890 
CSP28900 
CSP28910 
CSP28920 
CSP28930 
CSP28940 
CSP28950 
CSP28960 
CSP26970 
CSP28980 
CSP28990 
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PROBLEM 2 

The purpose of this program is to create invoices. The input deck is as follows: 




New name 
and balance 
mastercard 



Transaction 
cards 



Name and 

balance 

master card 




Input deck 



Detailed description of individual customer deck 



Each customer has the old master name and balance card, followed by the transaction 
cards, followed by a blank master name and balance card. The invoice is printed as in 
the example, and a new master name and balance card image is printed on the console 
printer. Then the next customer is processed until the stop code card is reached 
(ISTOP in cc 1-5). In an actual situation the new card image would be punched and 
stacker- selected. Then, as input to the next run of the program, a new input deck 
would have to be prepared. 

Switch settings are the same as for sample problem 1, except that output cannot be 
directed toward the console printer. 



Input 
Device 


Output 
Device 


Switches 





1 


2 


1442 


1132 


up 


down 


down 


1442 


1403 


up 


up 


down 


2501 


1132 


up 


down 


up 


2501 


1403 


up 


up 


up 



Make sure that the switches are set properly before the program begins. 

After processing is completed, sample problem 2 will STOP with 0111 displayed in the 
accumulator. Press START to continue. 

Note: Sample Problem 2 cannot be executed if Version 1 of the Monitor is being used. 
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Sample Problem 2: Detailed Description 

1. Read all constant information and determine output unit (1132 or 1403). 

2. Initialize error indicators. 

a. J=2 

b. 1=0, L=0, M=0 

3. Read the first card. It should be a master card. 

4. Is the card read in 3 the last card? 
No - 5 Yes - 64 

5. Is the card read in 3 above a master card? 
No - 72 Yes - 6 

6. Go to the top of a new page. 

7. Clear the print area. 

8. Print the customer name. 

9. Move the edit mark to the work area. 

10. Edit the previous balance. 

11. Print the customer street address. 

12. Move the words PREVIOUS BALANCE to the print area. 

13. Move the work area to the print area. 

14. Print the customer city, state, and zip code. 

15. Skip 3 lines. 

16. Print the column headings. 

17. Print the print area. 

18. Clear the print area. 

19. Convert the previous balance from Al format to decimal format. 
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20. Is the conversion in 19 correct? 
No - 66 Yes - 21 

21. Set the total (ISUM) equal to the previous balance. 

22. Set up the output area for the new master card. 

23. Read a card. 

24. Is the card read at 23 the last card? 
No — 25 Yes — 64 

25. Is the card read at 23 a master card? 
No — 26 Yes — 52 

26. Is the card read at 23 a transaction card? 
No — 49 Yes — 27 

27. Is the card read at 23 for the same customer being processed? 
No — 49 Yes — 28 

28. Move the item name to the print area. 

29. Move the edit mask to the print area for dollar amount. 

30. Move the edit mask to the print area for quantity. 

31. Edit the quantity. 

32. Edit the dollar amount. 

33. Print the detail line assembled in 28 through 32. 

34. Has channel 12 on the carriage tape been encountered? 
No - 35 Yes - 46 

35. Convert the dollar amount from Al format to decimal format. 

36. Is the conversion in 35 correct? 
No — 40 Yes — 37 

37. Add the dollar amount to ISUM. 
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38. Did overflow occur in the addition in 37? 
No - 23 Yes - 39 

39. STOP and display 777. 

40. Make the character in error a digit. 

41. Try to convert only the character in error. 

42. Is the conversion in 41 correct? 
No — 43 Yes — 44 

43. STOP and display 666. 

44. Convert the entire field back to Al format. 

45. Go to 35. 

46. Go to the top of a new page. 

47. Print the headings. 

48. Go to 35. 

49. Type ERROR on the console printer. 

50. Type the card read on the console printer. 

51. Go to 23. 

52. Convert the total (ISUM) from decimal format to Al format. 

53. Is the conversion in 52 correct? 
No — 54 Yes — 55 

54. STOP and display 555. 

55. Clear the print area. 

56. Move the edit mask to the print area. 

57. Edit the total (ISUM). 

58. Place the unedited total (ISUM) in the new master card. 

59. Type the new master card image on the console printer. 
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60. Move the word TOTAL to the print area. 

61. Skip 2 lines. 

62. Print the print area, the total line. 

63. Go to 2b. 

64. Type END OF JOB. 

65. STOP and display 111. 

66. Make the character in error a digit. 

67. Try to convert only the character in error. 

68. Is the conversion in 67 correct? 



No -69 



Yes - 70 



69. STOP and display 444. 

70. Convert the entire field back to Al format. 

71. Go to 19. 

72. Type ERROR on the console printer. 

73. Type the card read on the console printer. 

74. Go to 2b. 

Card Formats 



Customer Name 



99999999999999999999 

t 2 3 4 I I 7 I 9 10 11 I! I] II IS II 11 II 19 26 



Street Address 

99999999099999999999 
!i a a » a a n a » so ji b « m m » n 39 » 



9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 

42 41 44 15 41 41 41 49 50 SI 52 S3 54 5S 56 51 56 59 69 



9 9 9 9 9 9 9 9 

Bl 12 63 14 65 69 31 69 



99 

11 14 15 



9999 

16 V II 19 90 



Customer Name 



99999999999999999999 

I 2 3 4 S t 1 I » 10 11 12 13 1* 1S HIT II 18 » 



Total 
Amt. 



99999999999999999999 

II 22 13 24 23 H 27 M 21 » 31 32 33 34 35 36 37 31 M M 41 42 43 44 45 48 4T 48 49 50 51 5! 



99999999 



Qty 



9999 



Card 
Seq. 



9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 

S3 54 K 58 57 SB 59 80 61 it 83 «4 65 88 IT 88 



999 



99999 



7} 74 75 16 77 71 79 * 
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1130 COMMERCIAL 



SAMPLE PROBLEM 2 



• B3 • 

• »•• 



• INITIALIZE 



AND CONSTANTS 



• 02 • 



MASTER CARD 



• PRINT HEADING « 

AND PREVIOUS 

• BALANCE • 



• D2 • 

» » 



•IS REPLACED 

• PREVIOUS 

• BALANCE 



TRANSACTION 
«. CARD .« 



.• IS •. 

.•TRANSACTION*. NO 

.NAME EOUAL TO 

». MASTER .• 
•.NAME .» 



.X«. MASTER CARD 



TYPE NEH 

MASTER CAR!) 

IMAGE 



PRINT 
TOTAL 
LINE 



/ES 
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Sample Problem 2: Source Program 



//' FOR CSP29000 

•« SAMPLE PROBLEM 2 CSP29010 

« NAME SMPL2 CSP29020 

« LIST ALL CSP29030 

• ONE WORD INTEGI *S CSP29040 

• EXTENDED PRECISION CSP29050 

C THE INPUT IS MADE UP OF A MASTER CARD FOLLOWED BY THE TRANSACTION CSP2906O 

C CARDS FOR EACH CUSTOMER. WE WANT TO PRINT AN INVOICE AND PRINT A CSP29070 

C NEW MASTER CARD FOR EACH CUSTOMER. CSP2908O 

DIMENSION INCRDI82I . IWASKI13I . IPRNT I 79 ) t IOTCDI80) . I STOP ( 5 I . CSP29090 

1 IHEAD I 80 I. IPRVB! 161 »ITOT< 5) . IWKU3I .ISUMIBI . 1ERORI6I plEOJUOl CSP29100 

CALL DATSW (2pN2> CSP29110 

CALL RATSKI1.N3I CSP29120 

GO TO 128.271 >N2 CSP29130 

27 CALL READ! IEOJpl.10.JI CSP29140 
CALL READ! IER0R.1.6.J) CSP29150 
CALL READI IMASK.1.13.J) CSP29160 
CALL READ! IPRVB. 1.16. Jl CSP29170 
CALL READ! IHEAD. 1.72. J] CSP29180 
CALL READI IHEAD. 73.80. Jl CSP29190 
CALL READI ISTOP. 1.5. J) CSP29200 
CALL READ! 1T0T.1.5.J) CSP29210 
GO TO 58 CSP29220 

28 CALL R2901I IE0J.1.10.JI CSP29230 
CALL R2501I IEROR. 1.6. Jl CSP29240 
CALL R2501I IMASK.l .13. J) CSP29250 
CALL R2501I IPRVB. 1. 16. Jl CSP29260 
CALL R2501I IHEAOp 1 p72. Jl CSP29270 
CALL R25011 IMEAD.'S.SO.JI CSP29280 
CALL R250K ISTOP. 1.5. J) CSP29290 
CALL R2501IITOT.1.5.JI CSP29300 

SO J«2 CSP29310 

INCRDI81I-16448 CSP29320 

INCRDIS2I-5440 CSP29330 

1 1-0 CSP29340 
L-0 CSP293S0 
M-0 CSP29360 
GO TO 130.291. N2 CSP29370 

29 CALL READI 1NCR0.1 .80. J I CSP29380 
GO TO 59 CSP29390 

30 CALL R2501MNCRD. 1.80. Jl CSP29400 

59 IFIJ-ll 22.2.2 CSP29410 

2 IFINCOMPI IC'CRD. 1.5. ISTOP. 1)1 3.22.3 CSP29420 

3 CALL NZ0NEIINCRD.70.S.KI CSP29430 
IFIK-ll 26.4.26 CSP29440 

4 GO TO (34.331 .N3 CSP29450 

33 CALL SKIP! 12544) CSP29460 
GO TO 60 CSP29470 

34 CALL S1403I12544I CSP29480 

60 CALL FILL! IPRNT»1. 79. 164481 CSP29490 
GO TO (36.351. N3 CSP29500 

35 CALL PRINT! INCRD.l .20. 1 I CSP29510 
GO TO 61 C5P29520 

36 CALL P1403I INCRO.l. 20.11 CSP29530 

61 CALL MOVEI IMASK. 1.13. IWK.ll CSP29540 
CALL EDIT! INCRD. 61.68. IWK. 1.13) CSP29550 



-110- 



SAMPLE PROBLEM 2 

GO TO (36.371 iN3 

37 CALL PRINTIINCRD.21.40.II 
GO TO 62 

38 CALL P1403I INCRD. 21.40. II 

62 CALL MOVE! IPRVB.l . 16 • 1PRNT . 231 
CALL MOVE! IMS. 1 .13 > IPRNT.6TI 
GO TO 141.391 .N3 

39 CALLPRINTUNCRO.41.60.il 
CALL SKIPU6126I 

CALL PRINTUHEAD.1.80.II 
CALL PRINTIIPRNT.1.79.II 
GO TO 63 
41 CALLP1403IINCRD.41.60.il 

CALL S1403U612SI 
CALL P1403UHEAD.1.80.II 
CALL P1403IIPRNT.1.79.I) 

63 CALL FILL! IPRNT. 1.79. 164481 

40 CALL A1DECI1NCR0.61.68.LI 
IFIL) 5.5.23 

5 CALL M0VEUNCRD.61.68.ISUM.il 
CALL MOVEUNCRD.ltS0.IOTCD.il 

6 GO TO 132. 311. N2 

31 CALL READUNCRD.1.60.JI 
GO TO 64 

32 CALL R250KINCRD.1.60.J) 

64 IFIJ-ll 22.7.7 

7 CALL N2ONEIINCRD.70.5.K) 
IF(K-l) 18.19.6 

8 IFIK-2 I 16.9.18 

9 IFINCOMPI INCRO. 1.20. 10TCD.1)) 18.10.18 

10 CALL MOVE! INCRD. 21.40. IPRNT. 231 
CALL MOVE! IMASK. 1.13. IPRNT. 67) 
CALL MOVE! IMASK.3.8.IPRNT.T) 
IPRNTI121--4032 

CALL ED I T 1 1 NCRO .49 • 52 . 1 PRNT • 7 • 12 I 
CALL EDITUNCR0.41.48.IPRNT.67.79I 
GO T0I49.48I.N3 

48 CALL PRINTUPRNT.1.79.II 
GO TO 65 

49 CALL P1403I IPRNT. 1.79. II 
63 1FU-3I 11.11.17 

11 CALL A1DECIINCRD.41.48.LI 
IFIL.) 12.12.14 

12 CALL ADD! INCRD.41 .46 . 1SUM. 1 .8 .Ml 
IFIM) 13.6.13 

13 CALL IOND 
STOP 777' 

14 CALL NZONEI INCRD. L. 4. Nil 
Nl'O 

CALL A1DEC! INCRD. L.L.N1I 
IFIN1I 16.16.15 

15 CALL IOND 
STOP 666 

16 CALL OECAK INCRD. 41.46.L) 
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CSP29560 

CSP29570 

CSP29580 

CSP29590 

CSP29600 

CSP29610 

CSP29620 

CSP29630 

CSP29640 

CSP29650 

CSP29660 

CSP29670 

CSP29680 

CSP29690 

CSP29700 

CSP29710 

CSP29720 

CSP29730 

CSP29740 

CSP29750 

CSP29760 

CSP29770 

CSP29780 

CSP29790 

CSP29800 

CSP29810 

CSP29820 

CSP29630 

CSP29840 

CSP29650 

CSP29860 

CSP29870 

CSP29880 

CSP29890 

CSP29900 

CSP29910 

CSP29920 

CSP29930 

CSP29940 

CSP29950 

CSP29960 

CSP29970 

CSP29960 

CSP29990 

CSP30000 

CSP30010 

CSP30020 

CSP30030 

CSP30040 

CSP30050 

CSP30060 

CSP3O07O 

CSP3008O 

CSP30090 



SAMPLE PROBLEM 2 





L-0 




GO TO 11 


17 


GO TO 151. 501. N3 


50 


CALL SKIP(12544I 




CALL PRINT! IHEAD. 1.80.1 1 




GO TO 66 


51 


CALL S1403! 125441 




CALL P1403IIHEAD. 1.80.1) 


66 


I>0 




GO TO 11 


18 


CALL TYPERIIEROR.1.5) 




CALL TYPERIINCRD.'..82> 




GO TO 6 


19 


CALL DECAll I5UM.1.8.L) 




IFIL) 20.21.20 


20 


CALL IOND 




STOP 335 


21 


CALL FILLUPRNT. 1.79. 16446) 




CALL MOVE! IMASK. 1.13. IPRNT. 671 




CALL ED1TIISUM.1.8.IPRNT.67.79) 




CALL M0VEIISUM.1.6.I0TCD.61) 




CALL TYPERUOTCD. 1.801 




CALL MOVE! IT0T.1.5.IPRNT. 231 




GO TO (55.54I.N3 


54 


CALL 5KIPI15672I 




CALL PRINTMPRNT.1.79.I) 




GO TO 67 


35 


CALL S1403I13S72) 




CALL P1403! IPRNT. 1.79. I) 


67 


CALL TYPERI INCRD. 81. 82) 




GO TO 1 


22 


CALL TYPERIIEOJ. 1.101 




CALL IOND 




STOP 111 


23 


CALL NZONEI INCRD. L. 4 .Nil 




Nl-0 




CALL A1DECIINCRD.L.L.N1I 




IF(Nl) 23.29.24 


24 


CALL IOND 




STOP 444 


25 


CALL DECA1IINCRD.61.68.LI 




L-0 




GO TO 40 


26 


CALL TYPERI IEROR.1.51 




CALL TYPERI INCRO. 1.621 




GO TO 1 




END 
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CSP30100 
CSP30110 
CSP3012O 
CSP3013O 
CSP30140 
CSP30150 
CSP30160 
CSP3017O 
CSP30160 
CSP30190 
CSP30200 
CSP30210 
CSP30220 
CSP30230 
CSP30240 
CSP30250 
CSP30260 
CSP3027O 
CSP3028O 
CSP30290 
CSP30300 
CSP30310 
CSP30320 
C5P30330 
CSP30340 
CSP3O350 
CSP30360 
CSP30370 
CSP30380 
CSP30390 
CSP30400 
CSP30410 
CSP30420 
CSP30430 
CSP30440 
CSP30450 
CSP30460 
CSP30470 
CSP30480 
CSP30490 
CSP30S00 
CSP30510 
CSP30320 
CSP30330 
CSP30540 
CSP30550 
CSP30560 



VARIABLE ALLOCATIONS 
INCRD-OOS1 IMASK-005E 
IEROR-0182 IE0J -018C 

STATEMENT ALLOCATIONS 
27 -01D6 28 -0208 



IPRNT-OOAD IOTC0-0OFD 
N2 -018D N3 -018E 



1STOP-0102 IHEAO-0132 IPRVB-0162 1T0T -0167 IWK -0174 ISUM -017C 
J -018F I -0190 L -0191 M -0192 K -0193 Nl -0194 



-0248 29 -02SA 30 -0262 59 -0266 2 -026E 3 



-0277 4 -0283 
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SAMPLE PROBLEM ? 




















PACE 


04 














33 -0289 34 


-028E 


60 


• 0291 


35 


-029D 


36 


•02A5 


61 


• 02AB 


37 


■ 02C0 


38 


•02C8 


62 


• 02CE 


39 


■02E2 


111 -02F9 63 


■030E 


40 


-0314 


5 


•031E 


6 


-032C 


31 


• 0332 


32 


•033A 


64 


-0340 


7 


■0346 


8 


•0354 


9 -035A 10 


-0363 


48 


-0395 


49 


-039D 


65 


• 03A3 


11 


-03A9 


12 


• 03B3 


13 


• 03C0 


14 


■03C4 


15 


•0308 


16 -03DC 17 


• 03ES 


50 


-03EE 


51 


-03F9 


66 


• 0402 


18 


■ 0408 


19 


■ 0414 


20 


•041E 


21 


-0422 


54 


■ 0450 


55 «0<i5B 67 


-0464 


22 


-046B 


23 


• 0474 


24 


-0488 


25 


-04SC 


26 


• 0498 















FEATURES SUPPORTED 
ONE WORD INTESERS 
EXTENDED PRECISION 



CALLED SUBPROGRAMS 
DATSW READ R2501 
OECA1 TYPER STOP 



NCOMP NZONE SKIP 



51403 FILL 



PRINT P1403 



A1DEC ADD 



INTEOER CONSTANTS 



2-0198 

16448-01A2 
40-01AC 
49-01B6 
81-01C0 



1>0199 

5440-01A3 

23-01AD 

52-01B7 

111-01C1 



10>019A 

0-01A4 

67-01AE 

12-01BB 

444-01C2 



CORE REQUIREMENTS FOR SMPL2 
COMMON VARIABLES 



6-019B 

70»01A5 

41-01AF 

48-0189 

1911-01C3 



13-019C 

12544-01A6 

60-0160 

777-01BA 

1638-01C4 



16-019D 

79-01A7 

16128-01B1 

4-01BB 

1365-01C5 



72>019E 

20-01A8 

3-01B2 

666-01BC 

273-01C6 



73-019F 

61-01A9 

8-01B3 

82-01BD 

1O92-01C7 



80-01AO 

68-01AA 

7-01B4 

555.01BE 



5-01A1 

21-01AB 

4032-0105 

15872-01BF 



406 PROGRAM 



END OF COMPILATION 
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Sample Problem 2: Invoice Output 



DAVES MARKET 

1997 WASHINGTON ST. 

NEWTOWN. MASS. 02158 



oty 


NAME 




PREVIOUS BALANCE 


e 


SUGAR - SAGS 


11 


CHICKEN SOUP - CASES 


10 


TOMATO SOUP - CASES 


8 


SUGAR RETURNED 


6 


COOKIES - CASES 


n 


GINGER ALE - CASES 


17 


ROOT BEER - CASES 


17 


ORANGE ADE - CASES 


17 


CREME SODA - CASES 


17 


CHERRY SODA - CASES 


17 


SODA WATER - CASES 


25 


DOG FOOD - CASES 


25 


CAT FOOD - CASES 


10 


SOAP POWDER - CASES 


10 


DETERGENT - CASES 


12 


HAM - TINS 


12 


HAM - LOAF 


12 


SALAMI 


12 


BOLOGNA 


12 


CORNED BEEF 


12 


ROAST BEEF 


1.000 


BREAD - LOAF 


4.000 


ROLLS 


200 


MILK - QUARTS 


100 


MILK - HALF GALS 


50 


MILK - GALS 


100 


POTATOES - BAGS 


100 


TOMATOES - LOOSE 


100 


CARROTS - BUNCHES 


10 


DETERGENT - CASES 


12 


HAM - TINS 


12 


HAM - LOAF 


12 


SALAMI 


12 


BOLOGNA 


12 


CORNED BEEF 


12 


ROAST BEEF 


1.000 


BREAD - LOAF 


4.000 


ROLLS 


200 


MILK - QUARTS 


50 


MILK - GALS 


100 


MILK - HALF GALS 


100 


POTATOES - BAGS 


100 


TOMATOES - LOOSE 


100 


CARROTS - BUNCHES 


10 


OETERGENT - CASES 


12 


HAM - TINS 


1.000 


BREAD - LOAF 



AMT 
Sill. 29 
S21.02 
$38.76 
S30.ll 
$21.02CR 
S45.21 
$52.37 
S52.37 
$52.37 
$52.37 
$52.37 
$52.37 
$101.26 
$101.26 
$72.89 
$72.89 
$36.75 
$33.75 
$33.75 
$33.75 
$33.75 
$33.75 
$150.00 
$150.00 
$57.42 
$57.42 
$57.42 
$11.23 
$11.23 
$11.23 
$72.89 
$36.75 
$33.75 
$33.75 
$33.75 
$33.75 
$33.75 
$150.00 
$150.00 
$57.42 
$57.42 
$57.42 
$11.23 
$11.23 
$11.23 
$72.89 
$36.75 
$150.00 



QTY 


NAME 


4.000 


ROLLS 


200 


MILK - QUARTS 


100 


MILK - HALF GALS 


50 


MILK - GALS 


100 


POTATOES - BAGS 


100 


TOMATOES - LOOSE 


100 


CARROTS - BUNCHES 


10 


DETERGENT - CASES 


12 


HAM - TINS 


12 


HAM - LOAF 


12 


SALAMI 


12 


SOLOGNA 


12 


CORNED BEEF 


12 


ROAST BEEF 


1.000 


BREAD - LOAF 


4.000 


ROLLS 


200 


MILK - QUARTS 


100 


MILK - HALF GALS 


100 


MILK - HALF GALS 


100 


POTATOES - BAGS 


100 


TOMATOES - LOOSE 


100 


CARROTS - BUNCHES 


10 


DETERGENT - CASES 


12 


HAM - TINS 



AMT 
$150.00 
$57.42 
$57.42 
$57.42 
$11.23 
$11.23 
$11.23 
$72.89 
$36.75 
$33.75 
$33.75 
$33.75 
$33.75 
$33.75 
$150.00 
$150.00 
$57.42 
$57.42 
$57.42 
$11.23 
$11.23 
$11.23 
$72.89 
$36.75 



STAND I SH MOTORS 
10 WATER STREET 
PLYMOUTH. MASS. 02296 



20 

50 

50 

100 



NAME 

PREVIOUS BALANCE 
AIR CLEANERS - CASES 
GREASE - BARRELS 
TIRES - 650 X 13 
TIRES - 750 X 14 
TIRES - 800 X 14 
GASOLINE CAPS 



AMT 

$2,356.36 

$200.03 

$165.24 

$260.38 

$900.53 

$1,012.00 

$99.66 
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Sample Problem 2: Console Printer Log and New Master Card Listing 



ERROR THIS IS A DELIBERATE ERROR 

J CSP30660 

ERROR DAVE MARKET THIS CARO IS A DELIBERATE MISTAKE J C5P3068O 

DAVES MARKET 1997 WASHINGTON ST. NEWTOWN, MASS. 021580038932S A CSP30670 
ERROR STANDISH MOTOR THIS CARD IS NOT CORRECT ABCDEFGH I JKLHNOPQRSTUVJ CSP31470 
STANDISH MOTORS 10 WATER STREET PLYMOUTH, MASS . 02296001,991,22 A CSP31410 
END OF JOB 
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Sample Problem 2: Data Input Listing 



// XEQ 
END OF JOB 
ERROR 

• 1. CR 
PREVIOUS BALANCE 

OTY NAME 

AMT 
I STOP 
TOTAL 
THIS IS A DELIBERATE ERROR 



DAVES MARKET 
DAVE MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVE5 MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
OAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
D.AVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
OAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
OAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 



1997 WASHINGTON ST. NEWTOWN. MASS. 021560OO11 

THIS CARD IS A DELIBERATE MISTAKE 
SUGAR - BAGS OOO02102O0O8 
CHICKEN SOUP - CASES000038760011 
TOMATO SOUP - CASES 000030110010 
SUGAR RETURNED OOO0210KOO08 
COOKIES - CASES 000045210006 
GINGER ALE - CASES 000052370017 
ROOT BEER - CASES 000052370017 
ORA'IGE ADE - CASES 000052370017 
CREME SODA - CASES 000052370017 
CHERRY SODA - CASES 000052370017 
SODA WATER - CASES 000052370017 
DOG FOOD - CASES 000101260025 
CAT FOOD - CASES 000101260025 
SOAP POWDER - CASES OOO072S90O10 
DETERGENT - CASES 000072890010 



HAM - TINS 

HAM - LOAF 

SALAMI 

BOLOGNA 

CORNED BEEF 

ROAST BEEF 

BREAD - LOAF 

ROLLS 

MILK - QUARTS 

MILK - HALF GALS 

MILK - GALS 

POTATOES - BAGS 

TOMATOES - LOOSE 

CARROTS - BUNCHES 

DETERGENT - CASES 

HAM - TINS 

HAM - LOAF 

SALAMI 

BOLOGNA 

CORNED BEEF 

ROAST BEEF 

BREAD - LOAF 

ROLLS 

MILK - QUARTS 

MILK - GALS 

MILK - HALF GALS 

POTATOES - BAGS 

TOMATOES - LOOSE 

CARROTS - BUNCHES 

DETERGENT - CASES 

HAM - TINS 

BREW - LOAF 

ROLLS 



000036750012 
000033750012 
000033750012 
000033750012 
000033750012 
000033750012 
000150001000 
000150004000 
000057420200 
000057420100 
000057420050 
000011230100 
000011230100 
000011230100 
000072890010 
000036750012 
000033750012 
000033750012 
000033750012 
000033750012 
000033750012 
000150001000 
000150004000 
000057420200 
000057420050 
000057420100 
000011230100 
000011230100 
000011230100 
000072890010 
000036750012 
000150001000 
000150004000 



CSP30570 
CSP30580 
CSP30590 
CSP30600 
CSP30610 
C5P30620 
CSP30630 
CSP30640 
CSP306S0 
CSP30660 
CSP30670 
CSP30680 
CSP30690 
CSP30700 
CSP30710 
CSP30720 
CSP30730 
CSP30740 
CSP30750 
CSP30760 
CSP30770 
CSP30780 
CSP30790 
CSP30800 
CSP30810 
CSP30820 
CSP30830 
CSP30840 
CSP30850 
CSP30860 
CSP30870 
CSP30880 
CSP30890 
CSP30900 
CSP30910 
CSP30920 
CSP30930 
CSP30940 
CSP30950 
CSP30960 
CSP30970 
CSP309B0 
CSP30990 
CSP31000 
CSP31010 
CSP31020 
CSP31030 
CSP3104O 
CSP31050 
CSP31060 
CSP31070 
CSP31080 
CSP31090 
CSP31100 
CSP31110 
CSP31120 
CSP31130 
CSP31140 
CSP31150 
CSP3U60 



DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 



MARKET 
MARKET 
MARKET 
MARKET 

MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 



STANDISH 
STANDISH 
STANDI5H 
STANDISH 
STANDISH 
STANDISH 
STANDISH 
STANDISH 

I STOP 



MOTORS 

MOTORS 

MOTORS 

MOTORS 

MOTORS 

MOTORS 

MOTOR 

MOTORS 



MILK - QUARTS 
MILK - HALF GALS 
MILK - GALS 
POTATOES - BAGS 
TOMATOES - LOOSE 
CARROTS - BUNCHES 
DETERGENT - CASES 
HAM - TINS 
HAM - LOAF 
SALAMI 
BOLOGNA 
CORNED BEEF 
ROAST BEEF 
BREAD - LOAF 
ROLLS 

MILK - QUARTS 
MILK - HALF GALS 
MILK - HALF GALS 
POTATOES - BAGS 
TOMATOES - LOOSE 
CARROTS - BUNCHES 
DETERGENT - CASES 
HAM - TINS 



000057420200 
000057420100 
000057420050 
000011230100 
000011230100 
000011230100 
000072990010 
000036750012 
000033750012 
000033750012 
000033750012 
000033750012 
000033750012 
000150001000 
000150004000 
000057420200 
000057420100 
000057420100 
000011230100 
000011230100 
000011230100 
000072890010 
000036750012 



10 WATER STREET PLYMOUTH. MASS. 0229600235636 A 
AIR CLEANERS - CASES000200030020 J 

GREASE - BARRELS 000165240006 J 

TIRES - 650 X 13 000260380020 J 

TIRES - 750 X 14 000900530050 J 

TIRES - 800 X 14 001012000050 J 

THIS CARD IS NOT CORRECT ABCDEFGHIJKLMNOPQRSTUVJ 
GASOLINE CAPS 000099680100 J 



CSP3U70 
CSP31180 
CSP31190 
CSP31200 
CSP31210 
CSP31220 
CSP31230 
CSP31240 
CSP31250 
CSP31260 
CSP31270 
CSP31280 
CSP31290 
CSP31300 
CSP31310 
CSP31320 
CSP31330 
CSP31340 
CSP31350 
CSP31360 
CSP31370 
CSP31380 
CSP31390 
CSP31400 
CSP31410 
CSP31420 
CSP31430 
CSP31440 
CSP31450 
CSP31460 
CSP31470 
CSP31480 
CSP31490 
CSP31S00 
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PROBLEM 3 



The purpose of this program is to print a payroll register and punch a new year-to-date 
card for each employee. The input deck is as follows: 




Input deck 



Blank 



Current 
card 



Year-to-date 
card 



Employee deck 



Blank 



Year-to-date 
card 



Current 
card 



The year-to-date and current cards are read and processed. The payroll register is 
printed as in the example, and a new year-to-date card image is printed on the console 
printer. Then the next employee is processed. 

As is shown, the order of the year-to-date card and current card is not known before 
the cards are read. 



Switch settings 


are as follows: 








Input 
Device 


Output 
Device 


Switches 





1 


2 


1442 


console printer 


down 


down 


down 


1442 


1132 


up 


down 


down 


1442 


1403 


up 


up 


down 


2501 


console printer 


down 


down 


up 


2501 


1132 


up 


down 


up 


2501 


1403 


up 


up 


up 



Make sure that the switches are set properly before the program begins. 

After processing is completed, sample problem 3 will STOP with 3333 displayed in the 
accumulator. Press START to continue. 

A general purpose *IOCS card has been supplied with the sample problem. If this does 
not match the 1130 configuration to be used, a new *IOCS card will be required. 

*IOCS (CARD, 1132 PRINTER, TYPEWRITER) 
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Sample Problem 3: Detailed Description 

1. Determine the output unit from the data switches. 
Console printer, 1132 Printer, or 1403 Printer 

2. Read the edit mask. 

3. Read a card. 

4. Is the card read in (3) blank? 
Yes - 18 No - 5 

5. Is the card read in (3) a year-to-date card? 

Yes — 11 No — 6 

6. Is the card read in (3) a current card? 
Yes - 8 No - 7 

7. Stop. 

8. Move the employee number to storage (JEMP). 

9. Extract the number of hours worked (HRS). 

10. Go to (3) . 

11. Move the department number to storage (IDEP). 

12. Move the employee number to storage (IEMP). 

13. Move the employee name to storage (INM). 

14. Move the Social Security number to storage (ISS). 

15. Move the pay rate to storage (IRT). 

16. Move the year-to-date gross to storage (IYTD). 

17. Go to (3). 

18. Are IEMP and JEMP the same? 
Yes - 19 No — 24 

19. Current amount (CURR) is set equal to HRS times pay rate. 
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20. New year-to-date is set equal to CURR +IYTD. 

21. Print a new year-to-date card image on the console printer. 

22. Print the payroll register line as in the example. 

23. Go to (3). 

24. Halt. If start is pushed, go to (3). 

Card Formats 



99 



p- 

No. 

999 



999 



Employee Name 



9999999999999999999999 

7 9 » W 11 12 II 14 19 IB 17 It 19 30 21 22 23 »»» 2T 71 



Employee Name 



999999999 99999999999 

4 S I 7 I 9 tO II 12 11 14 15 16 17 II 11 20 21 22 23 



99 



99 



Social 
Security 



999999999 

29 30 31 12 33 34 35 36 37 



9999 

7129 30 31 



9999 

39 39 40 41 



YTD 
Gross 

9999999 

42 43 44 43 46 47 48 



999999999999993999999 

49 50 SI 52 53 54 SS 55 57 59 59 80 61 62 63 64 65 K 67 68 63 



9999999999 9999999 99 999999 9 99 9 999999 999 

37 13 34 35 36 17 34 39 40 41 42 43 44 45 4B 47 41 49 50 51 52 53 54 55 56 57 U 59 CO 61 B2 63 64 65 66 67 51 69 



c 
s 

p 

999 

13 74 75 



99991 

76 77 79 79 HO 



c 
s 
p 

999 

'3 74 75 



Card 
lieq. 



Card 

fioq. 
No. 



99999 

77 79 79 » 



999999999999999999999999999999999999999999999999999999999999999999999 

1 1 3 4 5 I 7 9 9 10 II 12 t3 14 15 19 77 19 19 20 21 12 23 24 25 29 27 29 29 30 31 32 33 34 35 36 37 30 J9 40 41 42 43 44 45 46 47 49 49 50 51 52 53 54 55 56 57 56 59 66 6162 63 64 65 66 67 65 69 



C 

s 

p 

999 

73 74 75 



Card 
Seq. 
No. 



99999 

76 77 76 79 90 



when New YTD 
Code = 1 when year-to-date 
2 when current 

99999999999999999999999999999999999999999999999999999999999999999999999999999999 

1 3 3 4 5 9 7 9 9 10 II 12 13 14 15 16 17 15 19 20 21 32 23 24 25 26 27 21 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 41 49 50 51 52 53 54 55 56 57 55 59 60 6162 63 64 65 66 67 66 69 70 71 72 73 74 73 75 77 76 79 60 
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1130 COMMERCIAL 



SAMPLE PROBLEM 3 



(DETERMINE 

OUTPUT 

UNIT 



• NZERO 
•IS REPLACED BY 

• NZERQ t 1 



NO .• IS NZERO 
. ..». EQUAL TO 
». 1 



• READ EDIT 
MASK 

» 


. 


• * > 

• D3 «... 

• • .X.... 

• »•• . 
X 


.... 


• READ A 
CARO 


* 



IS CODE 
EQUAL TO 



» IOtP 
•IS REPLACED BY 
. DEPARTMENT 
» NUMBER 



NO .» IS IEMP 
, ..«. EQUAL TO 
•. JEMP 



TYPE 

THE EMP. N05. 
DO NOT MATCH 



• CURR • 
•IS REPLACED BY • 

• HRS • IRT • 



• YTD 

•IS REPLACED BY 

■ CURR £ I YTD 



IS CODE •. 
EQUAL TO 

1 .• 



IS CODE 

EQUAL TO 

2 



• JEMP • 
•IS REPLACED BY • 

• EMPLOYEE ,4UMBE*> 



• IEMP • 
•IS RtPLACED BY • 

•EMPLOYEE NUMBER- 



INM 
•IS REPLACED BY 
• EMPLOYEE NAME 



• ISS • 

•IS REPLACED BY • 
•SUCIAL SECURITY* 

• NUMBER • 



• HRS 

•IS REPLACED BY 

• HOURS WORKED 



• IRT 

•IS REPLACED bY 

• PaY RATE 



PRINT 
OETAIL LINE 



I YTD 

IS REPLACED BY 

YEAR-TU-DATE 

GROSS 



• ••• 

• • 

• D3 • 

• » 

• ••• 
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Sample Problem 3: Source Program 



// JOB CSP31510 

// FOR CSP31320 

» NAME SP3 CSP31530 

»10CS(CARD.H32 PRINTER. TYPEWRITER! CSP31540 

• ONE WORD 1NTESERS CSP31590 

• EXTENDED PRECISION CSP31560 

• LIST ALL CSP31970 

DIMENSION MASK(12ltIN(69>tIDEP(2)tIEMP(3l.lNM(20I.ISS(9I.IRT<4>. CSP31580 
1 IYTO(7).JEMP(3).NYTO(7I.ICURI6I.KCURR(12>.KOYTD(12).KNYTD(12> CSP31590 

1 FORMAT I69A1.I1> CSP31600 

2 FORMAT U2A1I CSP31610 
20 FORMAT (1M .2AI tlX.23Al.2Xt 20A1 .21X. 1M1 .3X.7HCSP ) CSP31620 
30 FORMAT ( 1M .2A1 .2X.3A1 .2X.20A1 .SX.3 1 12A1 .2X I I CSP31630 

CALL DATSW(O.l) CSP31640 

CALL DATSWU.MI CSP31650 

CALL DATSWI2.LI CSP31660 

NREAD-6»(l/LH-2 " CSP31670 

NWR1T-2«(1/I)+2»(1/M>-H CSP31680 

READ (NREA0.2) MASK CSP31690 

15 READ (NREAD.l) IN.1CD CSP31700 

IF (ICDI 6.10.6 CSP31710 

6 NZERO-0 CSP31720 

GO TO (7.8J. ICD CSP31730 

C THIS IS THE YEAR TO DATE PROCESSIN6 CSP31740 

7 CALL MOVE ( IN. 1 .2 . IOEP. 1 ) CSP31750 

CALL MOVE UN.4i6.ICMP.il CSP31760 

CALL MOVE IIN.7t26.INM.il CSP3177D 

CALL MOVE IIN.29.37.ISS.il CSP31780 

CALL MOVE IIN.39.4l.IRT.il CSP31790 

CALL MOVE IIN.42.4S.IYT0.il CSP31S00 

SO TO IS CSP31S10 

C THIS IS CURRENT PERIOD PROCESSINS CSP31B20 

CALL MOVE ( IN.1.3.JEMP.1I CSP31830 

HRS-GET (IN. 28. 30.100. 01 CSP31S40 

00 TO IS CSP31B50 

NZERO ■ NZERO * 1 CSP31860 

IF (NZERO - II 100.100.101 CSP31870 

STOP 3333 CSP318B0 

IF <NC0MPCI£MP.1.3.JEMP.1> I 99.11.99 CSP31S90 

11 CURR-(HRS»GET(IRT.l. 4.10. 01+500. 01/1000.0 CSP31900 

YTO-CURR+GET I IYTD.1.7t 10.01 CSP31910 

CALL PUT INYTDtli7.YTD.S.0.1) CSP31920 

WRITE (1.201 IDEP.IEMP.INM.1SS.IRT.NYTD CSP31930 

CALL PUT (ICUR.1.6.CURR.5.0.1I CSP31940 

CALL MOVE (MASK. 1. 12.KCURR.il CSP31930 

CALL MOVE (MASK. 1. 12.K0YTD.il CSP31960 

CALL MOVE IMASK.ltl2.KNYTD.il CSP31970 

CALL EDIT (ICUR.lt6tKCURRtl.12l CSP319SD 

CALL EDIT IIYTD.lt7tK0YTDfl.12l CSP31990 

CALL EDIT INYT0.1.7.KNYTD.1.12I CSP32000 

WRITE (NWRIT.30I IDEP. 1EMP. INM.KOYTD.KCURR.KNYTD CSP32010 

GO TO 15 CSP32020 

C THIS IS AN ERROR. THE EMP NOS 00 NOT MATCH. CSP32030 

99 WRITE (1.401 CSP32040 

40 FORMAT (' THE EMP NOS DO NOT MATCH. • I CSP32050 

GO TO IS CSP32060 



10 



101 

100 



SAMPLE PROBLEM 3 
END 

VARIABLE ALLOCATIONS 
HRS "0000 CURR '0003 
IYTD -0089 JEMP -008C 
NREAD'OOCl NWRIT-00C2 

STATEMENT ALLOCATIONS 
1 ■00E8 2 -OOEC 
101 -01CB 100 -01CD 
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CSP32070 














YTD 

NYTD 

ICD 


■0006 
• 0093 
■ 00C3 


MASK -0017 
I CUR -0099 

NZERO-00C4 


IN -005C 
KCURR-00A5 


IOEP -005E 
KOYTD-0081 


I EMP -0061 
KNYTD-OOBD 


INM 


-0075 
-OOBE 


ISS 

M 


-007E 
-008F 


IRT 

L 


-0082 
■OOCO 


20 
11 


■ OOEF 

■ 01D6 


30 "0103 
99 >0259 


40 -0114 


15 -016C 


6 -0178 


7 


-0182 


e 


-01AE 


10 


-01BF 



FEATURES SUPPORTED 
ONE WORD INTEGERS 
EXTENDED PRECISION 
IOCS 



CALLED SUBPROGRAMS 
OATSW MOVE GET 
SFIO SIOAI SIOI 



NCOMP 
STOP 



PUT 
CARDZ 



EDIT 
PRNTZ 



WRTYZ SRED 



REAL CONSTANTS 

.100000000E 03-00C6 



.100000000E 02-00C9 



•500000000E 03-OOCC 



•100000000E 04-OOCF 



•SOOOOOOOOE 01-0002 



INTEGER CONSTANTS 

0-0009 1-00D6 
41-QOOF 42-00E0 



2-00D7 

48-00E1 



6-O0D8 
3-00E2 



4-00D9 
28-00E3 



7-00DA 
30-00E4 



26-00DB 
3333-00E5 



29-00DC 
12-00E6 



37-00DD 
13107-OOE7 



CORE REQUIREMENTS FOR SP3 
COMMON VARIABLES 



198 PROGRAM 



END OF COMPILATION 
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Sample Problem 3: Payroll Register Output 



// 


XEO 








CSP32080 


01 


101 


NALNIUQ • J 


$7,453.06 


$198.91 


$7,651.97 


52 


201 


OMINOREGt M 


S3. 524. 37 


$143.82 


$3,668.19 


76 


676 


NEOAB. R 


(10.060.60 


S297.27 


$10,357.87 


76 


66? 


NEDUOL. R 


$10,060.60 


$297.27 


$10,357.87 


01 


253 


NROH t .1 


S9.955.62 


$279.65 


$9,635.27 
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Sample Problem 3: Console Printer Error Log and New Year-to-Date Card Image 



01 101NALNIUQ, J 7985661(32051420765197 



52 201OMINOREG, M 0133256780i(230366B19 



76 676NEDAB, R 011(23306008101035787 



76 689NEDU0L, R 798603791(08101035787 



THE EMP NOS DO NOT MATCH. 



01 253NROH, J 951(62305707620983527 
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Sample Problem 3: Data Input Listing 



// XEO 

• S. CR 

01 101NALNIUO i J 
101NALNIUO . J 



M 



201OMINOREO. 
92 2010MINORES. 



76 676NEDAB, 
676NU0AB. R 



689NEDUOI. R 
76 689NEDUOLt R 



99 9990NA7NOM J 
099ONATNOM i J 



01 253NR0H i J 
2S3NRQH . J 



79856643205420745306 
01367 



523*0 

0133256780423035243 7 



01423306008101006060 
76367 



76367 

79860379408101006060 



99999999901160911122 
994009 



99462305707620936562 
01367 



CSP32080 
CSP32090 
CSP32100 
CSP32110 
CSP32120 
CSP32130 
CSP32140 
CSP32130 
CSP32160 
CSP32170 
CSP32180 
CSP32190 
CSP32200 
CSP32210 
CSP32220 
CSP32230 
CSP32240 
CSP32250 
CSP32260 
CSP32270 
CSP32280 
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FLOWCHARTS 



I A DP I 
A1A3 
A1DEC 
A3A1 
CARRY 
DECA1 
DIV 

DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



1130 COMMERCIAL 



ADD/SUB SUBROUTINE 



***#A1* ******** 

* * 

* START SUB * 

* * 
*************** 



**«**Ij1* ********* 

* SET UP AN * 
♦INSTRUCTION TO * 

* CHANGfc JCARD *. 

* S I GN * 



*********** 



;**** 4 



****fl 2*******4* 

* * 

* START AUD * 

* * 

*************** 



*****B 2 ********** 
*CLEAR AND SAVt * 

*SIGNS ON JCARU * 

* ANO KCARO * 

* FIELDS * 

* * 
**********(< ****** 



*****C 2**** ****** 

* CALCULATE THE * 

*OPERATI0N-LS IGN* 
*JS REPLACED 3V * 

* JSIG-N * KSIGN * 

* * 
*********** ****** 



*****Q2**** ****** 

* KNCW IS * 

* REPLACfcU ttY * 
*KLAST - JLAST £* 

* J * 

* * 
*********** ****** 



***# 

« 

f C5 



*****F2**** ****** 



***************** 



*****G 2** ****** 
*KCARD<KNCW) IS 

* REPLACED BY 

* L5IGN * 

* JCARDUNjWI £ 

* KCAR01KNOWI 
*************** 



*****Q 'I* ********* 

♦KCARC(KLAST) IS* 

* REFLATED BY * 
*KCA»0(KLAST) C * 

* KNOW * 

* * 
**** ************* 



**** *c 3********4* 



**** ************* 



*****C^#* ******** 

* * 
♦KCAPGIKNCWI IS * 
♦REPLACEO 3Y 9 -* 

* KCAPD(KNOW) * 

* * 
***************** 



.* IS KNOU 

. LESS THAN 
*, KLAST . 



*****F 3********4* 

* * 

* KSTPN TS * 

* SEPLACEO PY * 

* -KSIGN * 
**** ************* 



* KNOW IS *. HI 

COMPARED TQ .*... 
*. ZERO .* 



*****B4********** 

* * 

* RESTORE SIGNS * 

* GN JCARD ANO * 

* KCAKD FIELLS * 
+ * 
***************** 



****Ct- ********* 

* * 

* EXIT * 

* * 

************* 4* 



***************** 



*****C5 ********** 



***************** 



***4* £4**4*4 ♦**** 

* * 

* KNOW IS * 
X* REPLACED BY * 

* KNOW C 1 * 

* * 
***************** 



*****H1 ********** 

* * 

* JNOW IS * 

* RcPLACEO iiY * 

* JNOW £ 1 * 

* * 
***************** 



*****H 2** ******** 

* * 

* KNCW I S * 

* REPLACEJ BY * 

* KNOW & 1 * 

* * 
***************** 



J2 * . 

.♦IS JNJW*. 
* GREATER 

THAN 
*. JLAST 

*. .* 

*. .* 



*****K2**** ****** 
*LARRY * 

* KCARD,K, * 

* KLAST.KNOW * 

* * 
***************** 
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1130 COMMERCIAL 



A1DEC SUBROUTINE 



• NZONE 

•-•-«-»-•-•-»-« 

• JCARO.JLAST, 

• 4.JSIGN 



» JNOW 

•IS REPLACED BY 

• J 



••••••••••••••••ft 



NO 


.• IS JTESI «. YES 


•YES .• IS JTEST *. NO . 




NO .• IS JTEST ». 




ft. -4032 .« 

*. .» . 

*• •* • 

* • 


». ZERO .« 

»• .* 

• • •• 

* 


\ 


•. BLANK .» 

• • •• 

**«YES 




X 






» ■ 

• NER * 
•IS REPLACED BY » 

• JNOW • 
■ « 


• JTEST • 
•IS REPLACED BY • 
•AN EBCDIC 2ER0 • 


; 












X 








• # 

• JCARDtJNOWn • 
•IS REPLACED BY • 
•tJTEST 6 *032n/» 

• 256 • 











ADD 
A1A3 
IA1DEC 
A3A1 
CARRY 
DECA1 
DIV 
DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



.» IS JNOW 
. LESS THAN 
«. JLAST . 



• JNOW 
.X«IS REPLACED 

• JNOW I I 



•IS REPLACED BY »X 
»-JCAR0*JLASTO-l» 



VES .• 15 JSIGN 
...... EQUAL TO 

• . 2 
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ADD 
|A1A3 
A1DEC 
A3A1 
CARRY 
DECA1 
DIV 

DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYED 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



1130 COMMERCIAL 



A1A3 SUBROUTINE 



****A1********* 

* # 

* START AIA3 * 

* * 
44****4******** 



4****81********* * 



******* ********** 



**4**l,l ********** 

* # 

* SAVE INDEX * 
♦RcGISTERS l,2t * 

* AND 3 * 

* * 
******* ******* 44* 



*****j}l 4*4*4****4 

* CRtATfc THd * 

* AQURESSES OF * 

* JCARD(J) A\0 * 

* KCARD(K) * 



****** 



******* 



*****EI ********* * 

* * 

* CALCULATE * 

* JLAST-Jfcl THE * 
*WlDTH OF JCARO * 

* * 
***************** 



*****F 1*4******4* 

* LOAD INDEX * 
♦REGISTER L WITH* 
*THE ADDRESS OF * 

* KCARD(K) * 

* * 
***************** 



*** 

* 

*Rt 



**ijl ********** 
LUAu INDEX * 
GtSTER I WITH* 
HE WIDTH OF * 
JCARO * 

************** 



* HI *.X 

* * 
**** 



*4***H1 ********** 

* LOAD THE * 

* ACCUMULATOR * 

* dlTH TS-E NEXT * 
*JC«KD CHARACTER* 

* * 
***************** 



X 


*. .* 




*#** 


* NO 




* * 






* A5 * 


. 




* * 






**** 


X 

.*. 

Kl *. 

.* * 






* IS 


* 


* 


INTEGER 






*. NEGATIVE 


* 



****A 2 ********* 

* * 

* START A3A1 * 

* * 
*************** 



4****52**** ****** 



*********** ****** 



«****£ 2 ********** 

* * 

* * 

* DIVIDE BY 160C * 

* * 

* * 
***************** 



****** 2******* 



***************** 

**** 

* * 

* E2 *. .. 

* * 
**** 



*****£ 

* ADD 

* ADJU 

* NE 

* I 



2********** 
32CC: TO * 
ST FOR A * 
GATIVE * 

NTtGER * 



***************** 



*****f 2 ********** 

* * 
♦DIVIDE BY 16CC * 

* TO GET THE * 

* FIRST VALUE * 

* * 
***************** 



*****G 2 ********** 



**** ** *********** 



*****H 2 ********** 

* * 

* DIVIDE BY 4C TO* 
*GtT THE SECOND * 

* VALUE * 

* * 
***************** 



*****J2**** ****** 



***************** 



*****K 2 ********** 
*USc THIRD VALUE* 
*Aa SUBSCRIPT TO* 

* LOOKUP TH IRD *. 

* CHARACTER * 

* * 
*********** ****** 



**** *fl 3********** 

* * 

* STCRE THIRC * 

* CHARACTER + 



***************** 



4*4* *Q 3********4* 

* USE SECOND * 

* VALUE AS * 

* SUBSCRIPT TO * 

* LOCKUP ^ECCNC * 

* CHARACTER * 
4*4***4****4**4** 



*****£ 3*******4*4 



************** 



**** *53********** 
*U^P FIRST VALUE* 
*AS SUBSCRIPT TO* 

* LOOKUP FIRST * 

* CHARACTER * 

* * 
***************** 



*****£ 3********** 



STCPE FIRST 
CHARACTER 



4*****44********* 



*****F3********** 



****** *4 4******** 



*«** *Q3********** 



• DECREMENT INDEX* 

♦ RC5 ESTER 2 BY 1* 



4* ** ************* 



* IS *. 

F IFLD WIDTH .* 
*. ZFRC .* 



**** * J "J* ********* 

* * 

* RESTCRF INDEX * 
+RFO ISTEBS I. 2.* 

* ANO 3 * 

* * 
*44****4* ******** 



*** *K3*4******* 
* * 

4 EXIT * 

4 * 

4*4 4*44**4***4* 



*****A4*******#4* 

* USE SECONC * 

* CHARACTER TO * 



4*******4***444** 



4**t*|34***** ***** 

*SUM THIS NUMBER* 
*WITH THE THIRD * 

*NUMBbR AND SAVE* 

* THE RESULT * 

* * 

************ 44 *** 



*****C4**** ****** 

* USE FIRST * 

* CHARACTER TO * 

♦SEARCH TABLE TO* 

* GET THE NUMBER * 

* * 
* * ********** 444* * 



4444*04********** 

♦ SUM THIS NUMBER* 

* WITH THE * 

♦PREVIOUS SUM TO* 

♦ GET THE RESUT * 

* * 
***************** 



*****E4*****4***ft 

* + 

* STORE THE * 

* RESULT IN THE * 

* KCARO FIELD * 

* + 
************ 4***4 



4*4* *F 4 ********** 



******* ******* 4* 4 



** 4*4(34**** ****** 



*******44** ****** 

***« 

* * 

* H4 *... 

* # 
**** 

X 
*****H4 ********** 

* * 

* LOAD THE + 

* ACCUMULATOR * 

* WITH A BLANK * 

* * 
***************** 



*****j 4*4*4 ****** 

* SAVE THE + 
♦ACCUMULATOR THE* 

* SECOND * 

* CHARACTER * 

* * 
****** *********** 



**** *K4**** ****** 

* * 

* LOAD THE * 

* ACCUMULATOR + 

* WITH A BLANK + 

* * 
***************** 



*****AS** ******"** 

* SAVE THE * 
♦ACCUMULATOR AS * 

* THE F IKST * 

* CHARACTER * 

* * 

********* ******. c* 



** 4**85** ******** 

* * 

♦JECRtMtNT INDE;<* 
4REGI STER 2 BY 1* 



***************** 



* IS * 

FIELD WIOTH 
*. lt*0 .* 



** 4 4=MJ5** ******** 

* LCAD THE * 

* ACCUMULATOR * 

* WI TM THE NEXT * 

♦JCARC CHARACTER* 



***** 



(*** ******** 



****#E5*4 ******** 

* SAVE THE * 
♦ACCUMULATOR THL-* 

* SECOND * 

* CHARACTER * 



****** 



********* 



#* ***p5 ****#****& 



♦ DECREMENT INDEX* 
♦REGI STE* 2 BY )* 



***************** 



*****H5 ********** 

* LOAD THE * 

* ACCUMULATOR * 

* WITH THE NEXT * 
♦JCARO CHARACTER* 

* * 
******* ********** 



__..RCH TABLE TO* 
♦GET THE NUMBER * 



********* ******** 



44 4* *«5 ********** 

* SAVE THIS * 

* NUMBER FOR * 

* LATER * 

* ACCUMULATION * 



** *** *# 



44** 



**+* 

* * 

* E2 * 

* * 
**** 



*«** 

* * 

* A4 * 

* * 
**** 
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CARRY SUBROUTINE 



» NCARY • 
•IS REPLACED BY • 



* JNOW 

•IS REPLACED BY 

• JLAST 



. JTEST 

•IS REPLACED BY 

» JCARDSJNOWn E 
• NCARY 



NCARY 

IS REPLACED BY 

JTEST / 10 



• JTEST 
•IS REPLACED BY 

• JTEST - 10 • 

• NCARY 



IS JTEST 
LESS THAN 



• JTEST 
•IS REPLACED BY 
. JTEST I 10 



• NCARY • 
•IS REPLACED BY • 

• NCARY - 1 • 



• JNOW 

•IS REPLACED BY 

• JNOW - 1 



» KARRY 

•IS REPLACEO BY 

• NCARY 



ADD 
A1A3 
A1DEC 
A3A1 
CARRY 
DECA1 
DIV 
DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



• JCARUUNOhn 
•IS REPLACEO BY 

• JTEST 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

IdecaYI 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



1130 COMMERCIAL 



DECA1 SUBROUTINE 



••••••• 



)• ■«••*» 



NO .• IS • 
...•.JCARDSJLASTn 
•.NEGATIVE .• 



• JSIGN 
•IS REPLACED BY 



• JCARDXJLASTn • 
•IS REPLACED BY » 
•-JCARO*JLASTa-l. 



• JNUW 

•IS REPLACED BY 

• J 



• JTEST 
•IS REPLACED BY 

• JCARDIJNOUn 



IS JTEST 

LESS THAN 

ZERO 



IS JTEST 

LESS THAN 

10 



• NER 

•IS REPLACED BY 

> JNUW 



• JCAROHJNOWn 
•IS REPLACED BY 

• 256 • JTEST - 

• 4032 



• JNQW 

•IS REPLACED BY 

• JNOU L 1 



IS JNOU 

LESS THAN 

. JLAST . 
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DIV SUBROUTINE 



.•IS KLAST - • 
. KSTRT-JSPAN 
•.NEGATIVE .• 



IS 

KLOH 

.POSITIVE 



FILL 

»-•—•—•-•-•-»— 

KCARD.KLOW, 

KSTRT.O 

•••••••••••••a 



•••»•»»•» 



• El • 

• • 
»••• 



IS • 
CAROSJFRSTn 
.PUSITIVE .• 



••••••••••*••»•*• 

•CLEAR AND SAVE • 

• SIGNS ON • 
•JCARD AND KCARQ» 

• FIELDS • 



t JSPAN 
•IS REPLACED BY 
• JLAST - J L 1 



*••••••••••••••• 

• KSTRT 
•IS REPLACED BY 

• K - 1 



• KLOH 
•IS REPLACED 

• K - JSPAN 

• 
►••*••••»»»•• 



•••••••••••••••a* 



IS JFRST •. YES 
LESS THAN 


• JFRST 


...X-IS REPLACED 


JLAST .• 


• JFRST £ 



NER 
•IS REPLACED BY 
• KLAST 

••*•«••••••••*•* 



NSIGN • 
-•—•-•—•—•—•—•-a 

KCARO, KLAST - • 
JSPAN, JSIGK • • 

KSIGN.KNOW • 
•••■••••••••••>• 



• NSIGN 

• KCARO, KLAST, 

• KSlGN,KNOW 



• JH1GH 

•IS REPLACED BY 

• JCARDSJFRSTn 



»•••••••••«••••» 

• KPUT 

<IS REPLACED BY 

• KLOW £ 

• JLAST - JFRST 



• KSTOP 

•IS REPLACED bY 

• KLAST d JFRST 

• - JLAST - 1 



• rs 


REPLACED 


RY 


■ 




KSTRT 




» 










**«# 


#**###*■ 


>•*•» 


*»«• 








* . 






• Fl 


* • > ■ 














• «• 


X 






«*«* 


***•»*#•**•** 


* 


MULT 






• IS 


&EPLACEO 


HY 


* 


• *1C 


• KCARDlKMu* 


• tKCARDSKMUaa/ 




■ 


JHtGH 




» 


» »»* 


**»#**■*■*>»•# 



• NtjUO 

•IS REPLACED BY 

• CULT 



••••••••••••■•a* 

• JNOri 

•IS REPLACED BY 

• JNUW & I 



.« IS MULT •. YES • KNUW 

.GREATER THAN .» X.IS REPLACED BY 

•. ZERO .• X • KM £ I 



< KCAROSKPUTa • 
•IS REPLACED BY • 
■ NQUO • 



• KPUT 

•IS REPLACED BY 

» KPUT £ 1 



IS KM 

LESS THAN 

. KSTOP . 



» JNOW 
•IS REPLACED 61 
JFRST 



■ KCARDXKNOWn 
•IS RtPLACEJ BY 

• k;a*u*knowu - 

• MULT • 

■ JCARU*JNUWLJ 



• KNOW 

•IS REPLACED BY 

• KNOW f. I 



IS JNOW 

LESS THAN 

. JLAST . 



IS KNOW 
LESS THAN 
. ZERO 



••••••••••••••■a 

• k;ard?kmu 
•is replaced by 

• KCARUfcKMn t 
» 10 « KNOW 



• MUL r 
•IS REPLACED BY 
-1 



• NGUO 

• IS REPLACED dY 

• N0I10 - 1 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

D ECA1 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



.X»IS REPLACED BY • 
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A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNP K 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYED 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



1130 COMMERCIAL 



E01I SUBROUTINE 



NZONE 

JCARD, JLAST, 

4, NSIGN 



• NDUMP 

•IS REPLACED BY 

• EBC01C BLANK 



• HONEY 

■IS REPLACED BY 

■ EBCDIC BLANK 



• KNOW 

•IS REPLACED BY 

• KLAST 



• JNOW 

•IS REPLACED BY 

• JLAST 



• »34* •• 




IS KTEST •. 


YES 


EQUAL TO 




16448 .♦ 


. 


• « • • 




*■ ■ • 


X 


• NO 


• •• • 








• H2 








• ••• 



.. .13. • 
IS KTEST 
EQUAL TO 

. 23616 



.• »14» • 
IS KTEST 

EOUAL TO 
. 23360 



» NDUMP 
•IS REPLACED BY 
» KTEST 



• «28« 

• MONEY 
■IS REPLACEO BY 

• KTEST 



X 
••••••••••••••a* 

• »19» 

• NZRSP 
•IS REPLACED BY 

• KNOW 



KTEST • 
IS REPLACED BY • 

JCARUSJNOHn • 



KCAR0*KN0Wti 

IS REPLACED BY 

KTEST 



• JNOW 

•IS REPLACED BY 

• JNOW - I 



IS 
NZRSP 
.POSITIVE 



•NZONE «27»« 
•-•-•-»-•-•-»-»-• 

• NZONE • 

• JCARD, JLAST. • 

• NSI&N. KTEST • 



ILL »2l" 

•—•-•—•-•-•-•-• 

FILL • 

KCARD.K, • 

KLAST, 23616 • 



.. .29. . 

IS NSIGN 

EQUAL TO 

2 



•IS REPLACED BY 
• KCArtDSKLASTa 



IS 
KTEST 

.NEGATIVE 



•31" 
IS 

KTEST 



IS KTEST 

EQUAL TO 
16446 



•KCAROSKLAST-la 
•IS REPLACED BY 
• 16448 



• ••• 

* • 

• G5 • 



• 5» 

• KCASDWLASTU 
•IS REPLACEO UY 

• 1644B 



HI 



• ••• . 

X 
•••*•••••••••»•• 

• «17» 

• KTEST 

•IS REPLACED BY 

• KCARD*KNOWn 



• ••« 

• H2 • 



.• •20» • 

IS JNOW 

LESS THAN 

J 



•23« 
IS 

KTEST 
COHMA 



.. «32» • 
IS KTEST 
EQUAL TO 

. 24640 



.• «3« •. 

• IS NZRSP ■ 
GREATER THAN 
». .• 



.• «33« • 
IS KTEST 
FQUAL TO 

. -4032 



• «25» 

• NZRSP 

•IS REPLACED BY 

■ KNOW - 1 



*••» 

• ■ 

• G5 • 

• • 
• ••• 



FILL 
KCARD.K. 

NZJtSP.NDUKP 



• «11» 

• KNOW 

•IS REPLACED BY 

• KNOW - 1 



• KCARU*NZRSPa 
•IS REPLACED BY 

• MONEY 
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1130 COMMERCIAL 



DUNPK SUBROUTINE 



* A3 * 
A * 

**** 



****A1 ********* 
* 
START DUNPK * 
+ 

*************** 



*****B1********** 



***************** 



****A2********* 

* * 

* START OPACK * 

* * 

*************** 



*****B2**** ****** 



***************** 



*****C 2 ********** 



*********** ****** 



*****0 2** ******** 

* * 
♦CKEATE AuDRtSS * 

* OF JCARD(J) * 

* * A 



***************** 



*****F_2*« ******** 



***************** 



*****F2 ********** 



***************** 



*****G2 ********** 

* LOAD INJtX * 
♦REGISTER 1 WITH* 

* ADDRESS UF * 

* KCARO(K) * 

* * 
***************** 



*****p 3# ********* 



**** ************* 



*****C3********** 



***************** 



#****f 3******* *«* 



4*** ************* 



*****F 3**** ****** 



***************** 



IS 
FILLER 

NEEDED 



*****£ 4 ********** 

* PUT IN * 

* NECESSARY * 

* AMOUNT OF * 

* FILLER * 

* * 
***************** 



*****D^**** ****** 



***************** 



*««**E:4-*** ******* 



***************** 



*****P4*** ******* 



***************** 

**** I 

* * , 

* G4 *.X. 

* * , 
**** . 

X 
*****G4. ********** 

* * 

* STORE THE * 
♦ACCUMULATOR IN * 

* KCARD * 

* * 
***************** 



**** 

* * 

* A5 * 

* * 
**** 



*****A5** ******** 

* SHIFT AND * 

* ROTATE TO PUT * 

* DIGIT IN LOW * 

* ORDER OF THE * 

* tXTLNSIUN * 
***************** 



.* IS THIS * 
. JCARD(JLAST) 



*****C5 ********** 



***************** 



COUNT ZERO 



** ** *£5** ******** 



************ 



*****F5 ********** 



************* 



ADD 

A1A3 

A1DEC 
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CARRY 
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PACK 

PRINT 
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PUT 

P1403 

P1442 

READ 

R2501 
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STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



**«**H 2** ******** 

* LOAD THE * 

* ACCUMULATOR * 

* WITH THE NEXT * 

♦JCARD CHARACTER* 

* * 
***************** 



*****H4 ********** 

* * 

* RESTORE INCEX * 
♦REGISTERS 1 AND* 

* 2 * 

* * 
***************** 



*****J2** ******** 

* * 

* LOAD INDEX * 
♦REGISTER 2 WITH* 

* 4 * 

* * 
***************** 



****j4 ********* 

* * 

* EXIT * 

* * 
*************** 



IS 

SWITCH 
DUNPK 
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1130 COMMERCIAL 



FILL SUBROUTINE 



• JCARDJJNOWn » 
•IS REPLACED BY • 

• NCH • 



•IS REPLACED BY • 
• JNOH & 1 * 



•• IS JNOH • 
.GREATER THAN 
.. JLAST .• 
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1130 COMMERCIAL 



GET FUNCTION 



NZONE 

JCARDtJLAST. 

4, NSIGN 



. JTEST 

•IS REPLACED BY 
. JCARD*JNOKn 



• JNOW 
.X»IS REPLACED BY 
» JNOW £ I 



«• IS JTEST ». NO • GET 

I A BLANK .•.. XMS REPLACED BY 

.. .« X • 0.0 

•••••»•»•••••■•• 



• JTEST • 

•IS REPLACED BY « 
•AN EBCDIC ZERO • 



LESS THAN . 
.AN EOCDIC 
•.ZERO .» 



NO .• IS JNOW • 

GREATER THAN 

•. JLAST .• 



• GET 

•IS REPLACED BY 

• SHIFT • GET 



NZONE 

JCARD.JLAST, 

NSIGN, JTEST 



•••••••••••••••• 

I GET 

■is replaced by 

• MINUS GET 
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X 

I GET 

•IS REPLACED BY 
•10«GETC»JTESTC 
• ".032U/256 
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1H0 COMMERCIAL 



ICOMP FUNCTION 



•CLEAR AND SAVE • 

• SIGNS ON • 
•JCARO AND KCARD' 

• FIELDS • 



• KSTRT 

US REPLACED BY 

• KLAST C J - 
» JLAST - 1 



.« IS K • 
.GREATER THAN 
•. KSTRT .• 









NO 








ICOMP 




; 


IS 


REPLACED 
-KSIGN 


BV • 













. • IS «. NO 

. KCARDIKNOWH .'... 
•.POSITIVE .• 



• RESTORE SIGNS • 

• ON • 
•JCARO AND KCARD* 

• FIELDS • 



• KNOW 

•IS REPLACED BV 

> KNOW £ 1 



IS KNOW 
LESS THAN 
. KSTRT . 



KS 

• IS RE PL 

• KSTR 



TRT 

ACEO 6V 
T £ 1 



• KNOW • 
•IS REPLACED BV • 

• KSTRT £ 1 • 



• JHASH 
•IS REPLACED BV 

• ZERO 



» JHASH 
•IS REPLACED BV 
• JHASH £ 
» JCARDtKSTRTn 



• ICOMP • 
•IS REPLACED BY • 
•JCARO^KSTRTO - • 

• KCARDlKNOWn • 



IS ICOMP 
EOUAL TO 
. ZERO 



. • IS ». NO 

.KSI3M • JSISN."... 
•.LESS THAM.» 
•.ZERO .• 



X 




• YES 


.Ives 




X '. 


••"is KSTRT '•. 

•. JLAST .• 

• # ■ • 

• NO 




• , 
KNOW • 

RFPLACED BY • 
KNOW 5 1 • 

• , 






X 
.• •. 

NO ."IS JSIGN •'•. 

•.NEGATIVE .• 

*. . * 

• ■ . » 

• YES 













• ICUMP • 
•IS REPLACED BV • 

• JSIGN • ICOMP • 



-134- 



# * a s«## 


» START 


« 






X 


• • *• 


• * »• 


■ • * *- 


.YES .« ANY •. 


...X". INTERRUPTS . 


•. PEN[ 


ING .« 



1130 COMMERCIAL 1 OND SUBROUTINE A r>Tl 
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GET 
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| IONDl 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 
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SKIP 
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S1403 
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1130 COMMERCIAL 



MOVE SUBROUTINE 



• KNOW • 
■IS REPLACED BY » 
« K t, JNOH - J « 



» KCARDtKNOWn • 
•IS REPLACED BY * 

• JCARDtJNOWn • 



IS JNOW 

LESS THAN 

. JLAST . 



* JNOW 

•IS REPLACED BY 

• JNOW C 1 



-136- 



1130 COMMERCIAL 



MPY SUBROUTINE 



HER 
REPLACED BY 
KLAST 



• KSTRT • 
,X»IS REPLACED BY • 

• K - JLAST C J • 
. -1 



NO .• IS KSTRT « 
...•.GREATER THAN 
•. ZERO .• 



•CLEAR AND SAVE • 

• SIGNS ON • 
•JCARD AND KCARD» 

• FIELDS • 



•»•••••••*•••• 

• FILL 

• KCARO, KSTRT, 
«. K-1.0 

• 
«»••••»•»»••«» 



• JFRST 
•IS REPLACED BY 

• J 



IS •. YES 

.JCARDJJFRSTn 

•.POSITIVE .• 



IS JFRST 
LESS THAN 
. JLAST . 



. JFRST 
.X»IS REPLACED BY 
• JFRST a 1 



••»•••• 



• ••• ■ 

• • ■ 

• J2 «... 

»••• ■ 
X 

"*" NS1GN • 

«-«-•-•-»-•-•-»-* 

• JCARD. JLAST. • 

• JSIGN.JNOW • 

•••••»••••••«•••• 



JNOW 

IS REPLACED BY 

JNDW 6 1 



•IS REPLACED BY 



•••«•»•*•••«•••• 

• MULT 

•IS REPLACED BY 

• KCARD*KMtl 



.• IS MULT «. NO 
.GREATER THAM .«... 
•. ZERO .» 



• KCARD*KMa 
•IS REPLACED BY 

• ZERO 



•»»••••••*•*»••• 



• KNOW 
•IS REPLACED B 

• KM t JFRST 

• - JLAST 



« J NOW 

•IS REPLACED BY 

• JFRST 

« 
••••»•»••••••••• 



• KCAROSKNOWn 
•IS REPLACED BY 

• MULT • 

• JCARDSJNOWa a 

• KCARDWNOWB 



•••••«••• 



■••••»• 



KNOW 

IS REPLACED BY 

KNOW C 1 



IS JNOW 
LESS THAN 
. JLAST . 



••••••••••••••••• 

I KM • 

<[S REPLACED BY < 
» KM C I • 



IS K 

LESS T 

KLAS 



KCARD, KSTRT, 
KLAST.KNOU 



>•»•••«• •• 



• NS1GN 
»-•-•-•-»-»-•- 

• k:aRD, KLAST, 

• JSI&N • KSIiiN 

• KNOW 
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1130 COMMERCIAL 



NCOMP FUNCTION 



„ 








„ 


• 




START 




* 


* 








• 






X 










J NOW 








s 


REPLACED 
J 


UY 








!x.. 










X 






. 








a . 






KNOW 




« 




s 


REPLACED 


HY 


• 


* 


K 


£ JNUH - 


,1 


• 






X 




• 


» 








» 


• 




NCOMP 




* 


« 


s 


REPLACED 


UY 


* 




JCARD«JN0wn/8 




* 


- KCARD^KNOWO/8* 



IS NCOMP 
EQUAL TO 

ZERO 



• J NOW 

•IS REPLACED BY 

» JNUrt £ 1 



. < IS JNOW •. NO 

•GREATER THAN 

«. JLAST .» 



-138- 



1130 COMMERCIAL 



NSIGN SUBROUTINE 



• NOLOS • 
•IS REPLACED BY • 

• 1 • 



» JTEST • 
•IS REPLACEO BY • 
• JCARDSJo • 



NO •• IS JTEST 
..•• LESS THAN 
•. ZERO 



• NOLDS • 
•IS REPLACED BY • 

• -1 • 



LOW .•NEHS»JTEST • 
...'. IS COMPARED 



.• IS NEWS • 
•.GREATER THAN 
•. ZERO .• 



• JTEST • 

•IS REPLACED BY • 

• -JTEST - 1 ♦ 
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JCARDXJO 

"EPLACE" 

JTEST 
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PACK 

PRINT 

PUNCH 

PUT 

P14G3 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



1.130 COMMERCIAL 



N20NE SUBROUTINE 



» JTEST • 
•IS REPLACED BV • 
» JCARDJJn • 



IS 

JTEST 
.NEGATIVE 



• IS JTEST • . NO 

E0U6L TO AN .'... 
'. EBCDIC .• 
•.ZERO .» 



IS NEWZ 

EOUAL TO 

2 



•*ES 



• JCARDtJn 
•IS REPLACED BV 

• 24640 

• 8EBCDIC - o 



IS JTEST 

EQUAL TO 

.24640 Z-a 



• NOLOZ 

•IS REPLACED BY 

• 2 



• NOLDZ 

•IS REPLACED BV 

• 5 11 *JTEST - 

• 4096a/4096 



IS NOLDZ 

LESS THAN 

5 



• JTEST 

•IS REPLACED BV 

• -12224 

• SEBCUIC 11-On 



IS NEWZ 

LESS THAN 

5 



» JCARDXJU 
•IS REPLACED BV 
•JTEST L 4096 • 
•JNEWZ - NOLDZa 
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1130 COMMERCIAL 



PACK/UNPAC SUBROUTINE 



START UNPAC 



START PACK 



SET SWITCH AT 
B* TO 

UNPAC 



SET SWITCH AT 
B* TD 
PACK 



• SAVE 
•INDEX REGISTER 
» 1 



•CREATE ADDRESS 
» OF JCARDlJo 



•CREATE ADDRESS 
• OF KCARDJKn 



•CREATE ADDRESS • 
•OF JCARDtJLASTn* 



• LOAD INDEX • 
•REGISTER 1 WITH" 

• ADDRESS OF • 

• KCARD%KO • 



• LOAD ACCUM. • 

• WITH NEXT 
•JCARD CHARACTER* 



• B<t 
IS 

SWITCH 
PACK 



• SHIFT HIGH • 
•ORDER CHARACTER" 
•TO LOW ORDER OF" 

• EXTENTION » 



•JCARO CHARACTER" 



• RUTATE ACCUM. 

• AND EXIENTION 
•8 TO CREATE A2 

• FORMAT 



"STORE ACCUM. IN" 

• KCARO USING • 
•INDEX REGISTER • 

• 1 • 



•DECREMENT INDEX" 

• REGISTER 1 BY » 

1 » 



. • HAS ». 

.JCARD2JLASTO . 
•.BEEN DONE." 



RETURN 
ADDRESS 



•REPOSITION THE 

• HIiH ORDER 

• CHARACTER 



• PLACE EBCDIC • 
•3LANK, HEX 40, • 
•IN LOU URDER OF" 

• ACCUMULATOR • 



•STORE ACCUM. IN" 
• KCARD USING » 
"INOEX REGISTER • 



•DECREMENT INDEX" 

• REGISTER 1 BY • 

• 1 



•SHIFT CHARACTER" 

• IN EXTENTION • 

• TO HIGH ORDER » 
•OF ACCUMULATOR • 
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S1403 

TYPER 
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WHOLE 



X 
EXIT 



• PLACE EBCDIC • 

• BLANK. HEX t*0 , • 
."IN LOW ORDER OF" 

• ACCUMULATOR • 
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1130 COMMERCIAL 



PRINT/SKIP SUBROUTINE 



• START PRINT • 



PRINTER 

BUSV 



• SET UP » 

• ADORE SSES FOR • 

• JCARO • 



•PRNT1 G2' 

•-•-■-•-•-«-•-•-• 
•2000iAREA, ERROR" 



• RESTORE INOEX 

• REGISTER 1 



• PRNT1 • 

•-•-•-•-•-•-•-a-* 
•SKIP REQUESTED • 



• START SKIP • 



NO .• IS 



SUPPRESSION 
.REOUESTED." 



• CHANGE PRNT1 • 
•CALL. 2000i TO • 

• 2010, AT G2 • 
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1130 COMMERCIAL 



PUT SUBROUTINE 



JNOH 
•IS REPLACED 
• JNOH e 1 



•IS REPLACED BY 

•ABS«VARn£ADJST 
• TRUNCATEO 



.» IS N • 
.GREATER THAN 
•• ZERO .• 



JNOH 
•IS REPLACED BY 
• ONE 



• DIGS 

•IS REPLACED BY 

• DIGS / 10.0 

• TRUNCATEO 



IS JNOH 

LESS THAN 

N 



• JNOH 

•IS REPLACED BY 

• JLAST 



• JNOH 

•IS REPLACED BY 

• JNOW - 1 



• DIGT 

•IS REPLACED BY 

• OIGS / 10.0 

• TRUNCATED 



• JCARO*J«OUn • 
•IS REPLACED BY • 
•256 • IFIKJDIGS- 

• -10.0 • DIGTo » 

• -'.032 • 



< DIGS 

•IS REPLACED BY 

• DIGT 



.• IS JNOW • 
.GREATER THAN 
• . J .• 



IS VAR 
LESS THAN 
. ZERO 
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NZONE 

JCARDtJLASTi 

2, JNOH 
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FILL 
GET 
ICOMP 
IOND 
KEYED 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
|P1403| 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



1130 COMMERCIAL 



P1403 SUBROUTINE 



****B2 ****-***** 

* * 

* START PL 40 3 * 

* * 
*************** 



*****C 2 ********** 



*********** ****** 



*****D2**** ****** 

* * 

* SET UP * 

* ADDRESSES FOR * 

* JCARJ * 

* * 
***************** 



*****£2**** ****** 



REVERSE AND 
PACK JCARD 



***************** 



*****F2**+* ****** 

* CONVERT I/O * 

* AREA FROM # 
»£3LDIC TO 14C3 * 

* COOE * 

* + 
***************** 



.* IS *. 

*. PRINTER 
* . BUS Y . * 

*. .* 



****B4 ********* 

* * 

* START S14^3 * 

* * 
*************** 



♦SKI P AfQUESTEC * 

* * 

**** ******«*****£ 



«****Q4 ******* *** 

* * 

* CHANGE PPNT3 + 
*CALL, 2CCC, TO * 

* 2C1 1 :, AT h2 * 
+ * 
***************** 



*20CC»A*EA» ERROR* 
* * 

***************** 



*****j2**** ****** 



**********#«***** 



+** *K' ********* 
+ + 

t EXIT + 
* * 

*************** 
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1130 COMMERCIAL 



P1442 SUBROUTINE 



* # 

* START P1442 * 

* * 
*** *4*4**##**** 



4*** *@3 ********** 



4*4* * 4***4****4*4: 



4+** *C3*4444***4* 

* SET UP * 

* ADDRESSES PCR * 

* JCARO * 

* * 
4*****4********** 



4*4*4C3##**fr***** 

* REVERSE JCARC * 

* * 

* * 
4*** 4*44********4: 



* JCARCt JLAST) , * 

* APE A 61 ? COUNT * 



*2"C,AR£A,ERRCR* 
* * 

4**************** 



4****gi********** 

* * 
4 * 

* REVERSC JCARC * 
4 * 
4 * 
4* ft** 4**4***4*4** 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

1P1442| 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



.* IS *. 

PUNCHING .* 

*.FIMSHEO .* 



♦****J3****4*44** 



g**************** 



*#* *K?*4****#*4 
4 # 

* EXIT * 

* * 
*** 444*4****4** 
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ADD 
A1A3 
A1DEC 
A3A1 
CARRY 
DECA1 
DIV 

DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
IPUNCHI 
PUT 
P1403 
P1442 
[READl 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



1130 COMMERCIAL 



READ/PUNCH SUBROUTINE 



» START READ 



SET UP 

ADDRESSES FOR 

JCARD 



» CARD1 » 

•-•—#—»—•—#—•—#—• 
•10C0,AREA,ERROR» 



« 0010.AREAU, • 
» JCARMJLASTn, • 
•CHARACTER COUNT- 



• START 


PUMCH • 


• SAVE INDEX • 
« REGISTER 1 • 







SET UP 

ADDRESSES FOR 

JCARD 



X 
SPEED 



• 0011, 

• JCAROJJLASTn, 

• AREAtl, COUNT 



• CARD1 • 
•2000, AREA, ERROR" 



NO .• REAOING • 
. .X». OR PUNCHING 
•.FINISHED .« 



X 
EXIT 
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R2501 SUBROUTINE 



*** *fl3#+ ******* 

* * 

* START R25 1 "! * 

* * 

*** 4********4*4 



*****e3***##**** 



**«.« #4*4 



**** *C3*#******** 

* + 

* SET UP * 

* ADDRESSES FOR * 

* JCARO * 

* * 
*4** ************* 



*4 *Q3****#* 



ft 4 4 >>********## 



*K"^,ARFA t EPRCR* 
4*4«*4*#******4*# 



* JC ARC( JLASTi , 



YES 


* 


Al 


Y 


. . .* 


*. 


ERRCRS 

* . ■ 






i 


NO 



44 W *h 3******* v*4 

* # 

■! PFVERSE JCARC * 

* * 

**** 4*4*4******** 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

|R2501| 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



#*#* *K3********** 



<*+*****♦***♦***» 



*##*K <,********* 

* * 
•X* EXIT * 

* * 

*4#4**4 ****** 4* 
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ADD 
A1A3 
A1DEC 
A3A1 
CARRY 
DECA1 
DIV 

DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
[STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



1130 COMMERCIAL 



STACK SUBROUTINE 



SELECT THE 

ALTERNATE 

STACKER 
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1130 COMMERCIAL 



SUB SUBROUTINE 



• START 

* 


I 


X 


» NSIGN 

• JCARDiJLASTi 

• OtJSISN 


a 

K 


X 


• AOD 

•JCARDiJtJLASTi 
•KCARD.K.KLAST, 

* NER 


• 

• 
* 


X 


• NSIGN 

• JCARD.JLAST, 

• O.JSIGN 




X 


• EXIT 

» 


; 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

S TACK 

|SUB| 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

I KEYBDl 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 

|TYPER| 
UNPAC 
WHOLE 



113D COHMERCIAL 



• START TYPER • 



.YES .« IS 
...X«. TYPEWRITER 
». BUSY 



• SET UP • 

• ADORESSES FOR • 

• JCARD • 



•HAKE CHARACTER 
•CDUNT SIXTY IF 
• IT IS NOT 
« ALREADY 



• C00O.AREAS1. • 

• AREAE1, • 
•CHARACTER COUNT* 



TYPEO 

-•—•—•—»-•— 
2000, AREA 



TYPER/KEYBD SUBROUTINE 



START KEYBD 



SAVE INDEX 
REGISTER 1 



IS 

KEYBOARD 
. BUSY 



SET UP 

ADDRESSES FOR 

JCARO 



•MAKE CHARACTER 
•COUNT SIXTY IF 

• IT IS NOT 

• ALREADY 



TYPEO 
lOOOiAREA 



IS 

KEYBOARD 
.FINISHEO 



-»-»-»-•- 



0010,AREAC1, 

JCARDSJLASTC, 

COUNT/2 



RESTORE INDEX 
REGISTER 1 
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1130 COMMERCIAL 



kHOLE FUNCTION 



• CALCULATE THE « 
•AMOUNT TO SHIFI" 

• RIGHT « 



is «. m 

AMOUNT .«... 
ZERO •• 



.« IS •. 

. NUMBER ALL 
•FRACTIONAL." 



SET RESULT 

EQUAL TO 

ZERO 



• SHIFT RIGHT • 

. TO DROP • 
•FRACTIONAL PART* 



SHIFT LEFT 

TO FILL WITH 

ZEROS 



STORE RESULT 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

I WHOLE | 
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LISTINGS 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// JOB 

// ASM 

• NAME ABO 

•• ADD/SUB SUBROUTINES FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 

» LIST 

0008 01104000 EN1 



(101 
(ID) 



0000 
0001 
0002 
0003 
0004 
0005 
0006 
000T 

oooe 

0009 
OOOA 
00 OB 
000C 01 
00 OE 
00 OF 00 

0011 

0012 

0013 

0014 oo 

0016 00 
0018 
00 It 
001A 
001B 
00 1C 
0010 
00 IE 
001F 00 

0021 

0022 
0023 
0024 
0029 
0026 
0027 
0028 
0029 



0000 

COFE 

doo; 

C002 

D028 

700S 

F06E 

7002 

0000 

COFD 

D022 

6970 

69800008 

C100 

99800002 

D049 

8004 

0017 

C58O0OO2 

99800001 

80FE 

4808 

COFC 

D03B 

C103 

0044 

0062 

99800009 

D037 

003A 

D04F 

0090 

S0F1 

D044 

0010 

C106 

D05E 



IHFS 

MDX 

ADO 



DC 

LD 

STO 

LD 

STO 

MDX 

EOR 

MDX 

DC 

LD 

STO 

STX 

LDX 

LD 

S 

STO 

A 

STO 

LD 

S 

A 

BSC 

LD 

STO 

LD 

STO 

STO 

S 

STO 

STO 

STO 

STO 

A 

STO 

STO 

LD 

STO 



002A 00 C4000000 



SUB 
ADD 



ADO ADO SUBROUTINE ENTRY POINT 

ADD I JCARDt Ji JLAST .KCARD.K .KLAST tNER ) 
THE FIELD JCARO(J) THROUGH 
JCARDIJLASTI IS ADDED TO THE 
FIELD KCAROIK) THROUGH 
KCARO(KLAST). 

SUB SUBTRACT SUBROUTINE ENTRY POINT 

SUB I JCARD. J. JLAST tKCARD.K. KLAST .NERI 
THE FIELD JCARDIJI THROUGH 
JCARDIJLASTI IS SUBTRACTED FROM 
THE FIELD KCARDIKI THROUGH 
KCARDIKLAST). 

ARGUMENT ADDRESS COMES IN HERE. 
PICK UP ARGUMENT ADDRESS. 
STORE IT AT ADD. 

IHFS LOAD THE INSTRUCTION TO CHANGE 

SWIT SIGN OF JCARO FOR SUBTRACT. 

ADD+3 START COMPUTING. 

HFFFF-SWIT-1 CHANGE SIGN OF SUBTRHNO 

• ♦2 SKIP OVER NEXT INSTRUCTION. 

•-• ARGUMENT AOORESS COMES IN HERE. 

MDX LOAD SKIP OVER INSTRUCTION. 

SWIT STORE IT AT SWIT. 

SAVE1+1 SAVE IR1. 

AOD PUT ARGUMENT ADDRESS IN IR1 

GET JCARD ADDRESS 

2 SUBTRACT JLAST VALUE 

00+1 PLACE ADDRESS FOR ADD OR SUBTR 

ONE+1 ADD CONSTANT OF ONE 

JPLUS+1 CREATE JCARDIJLASTI ADDRESS 

2 GET JLAST VALUE 

1 SUBTRACT J VALUE 
ONE+1 ADD CONSTANT OF ONE 
+ SKIP IF POSITIVE 

ONE+1 NEGATIVE OR ZERO-MAKE COUNT 1 
COUNT+1 STORE JCARD LENGTH 

3 GET KCARD ADDRE5S 

KCRD1 PLACE IN CALLING SEQUENCE OF 
KCRD2 CARRY AND FILL SUBROUTINES 
3 SUBTRACT KLAST VALUE 
KCRD3+1 PLACE LOAD ADOR FOR AOD/SUB 
KCRD4+1 PLACE STORE ADDS FOR RESULT 
KCR05+1 PLACE SUBTRACT AOORESS AND 
KCR06+1 STORE ADDR FOR NEG CARRY 
ONE+1 ADO CONSTANT OF ONE 
KCRD7+1 PLACE AODR FOR SIGN CHANGE 
KPLUS+1 PLACE ADDR OF SIGN OF KCARD 
6 GET NER ADDRESS 
ERA+1 SAVE NER ADDRESS 

CLEAR AND SAVE SIGNS ON JCARD 

AND KCARD FIELDS. 
•-• GET SIGN OF JCARD 



C5P00010 
CSP00020 
CSP00030 
CSP00040 
CSP00050 
CSP00060 
CSP00070 
CSP00080 
CSP00090 
CSP00100 
CSP00110 
CSP00120 
CSP0U13O 
CSP00140 
CSP00190 
CSP00160 
CSP00170 

cspooieo 

CSP00190 
C5P00200 
CSP00210 
CSP00220 
CSP00230 
CSP00240 
CSP00230 
CSP00260 
CSP0C270 
CSP00280 
C5P00290 
CSP00300 
CSP00310 
CSP00320 
CSP0033O 
CSP00340 
CSP00350 
CSP00360 
CSP00370 
CSP00380 
CSP00390 
CSP00400 
CSP00410 
CSP00420 
CSP00430 
CSP00440 
CSP00490 
C5P00460 
CSP00470 
CSP00460 
CSP00490 
CSP00900 
CSP00510 
CSP00920 
CSP00530 
CSP00940 
CSP00990 
CSP00960 
CSP00970 
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002C 


D070 




STO 




0020 


7002 


SWIT 


MDX 




002E 01 


0*800026 




STO 


I 


0030 01 


4C100037 




BSC 


L 


0032 


F069 




EOR 




0033 01 


0*800028 




STO 


I 


0035 01 


740100*1 




MDX 


L 


0037 00 


C4O0O0O0 


KPLUS 


LO 


L 


0039 


0064 




STO 




003* 01 


4C100041 




BSC 


L 


003C 


F03F 




EOR 




0030 01 


D4800038 




STO 


I 


003F 01 


74010041 




MDX 


L 



0041 





C062 


0042 





D017 


0043 





C063 


0044 





DOFC 


0043 





CIO* 


0046 





001C 


00*7 





D03A 



LO 


OPR 


STO 


DO 


LO 


OPO 


STO 


OP 


LO 


1 4 


STO 


Kl 


STO 


K2 



00*6 


00 


C3S00009 




LD 


11 


004A 





003B 




STO 




0048 


00 


93800004 




S 


U 


0040 





0021 




STO 




004E 


00 


95800002 




S 


11 


0030 


00 


83800001 




A 


11 


0032 


01 


4C2800A0 




BSC 


L 


0054 





7107 




MDX 


1 


0033 





6928 




STX 


1 


0036 


00 


69000000 


COUNT 


LDX 


LI 


0038 


00 


C3OOOO00 


KCRD3 


LD 


LI 


OOSA 


00 


85000000 


DO 


A 


LI 


005C 


00 


D9000000 


KCRD4 


STO 


LI 



003E 71FF 
005F 70F8 



0060 30 03099668 



MDX 
MDX 



AGAIN CALL 



JSIGN SAVE SIGN OF JCARO 
»+2 SKIP ON ADD-CHANGE SIGN ON SUBT 
JPLUS+1 STORE CHANGED SIGN OF JCARD 
KPLUSi- DETERMINE SIGN OF JCARD 
HFFFF NEGATIVE - MAKE POSITIVE 
JPLUS+1 STORE IT POSITIVE 
OP.l CHANGE OPERATION - SEE OP & OPR 
«-« GET SIGN OF KCARD' 
KSIGN SAVE SIGN OF KCARD 
0P»- DETERMINE SIGN OF KCARD 
HFFFF NEGATIVE - MAKE POSITIVE 
KPLUS* 1 STORE IT POSITIVE 
0P»1 CHANGE OPERATION - SEE OP 6 OPR 
CALCULATE THE OPERATION. 
INITIALLY THIS IS FOR ADO. IT 
CAN BE CHANGED UP TO TWO TIMES. 
FIRST TO SUBTRACT AND THEN BACK 
AGAIN TO ADD. SEE OPR. 
PICK UP OPERATION 
STORE IT AT DO 

RESET THE PICK UP INSTRCTN TO * 
WITH INSTRUCTION AT OPO 
GET ADDRESS OF K 
STORE IT AT Kl FOR CARRY SUBRTN 
AND AT K2 FOR FILL SUBROUTINE 
DETERMINE IF JCARD IS LONGER 
THAN KCARD. KLAST-JLAST+J-KNOW 
IS COMPARED TO K. IF KNOW IS 
GREATER THAN OR EQUAL TO K GO 
TO KLAS3 FOR ERROR. 

3 GET KLAST VALUE 

KLAS3-H SAVE IT TO INDICATE ERROR 

4 SUBTRACT K VALUE 

COMP+1 SAVE FOR CMPLMNT ON NEG CARRY 

2 SUBTRACT JLAST VALUE 

1 ADO J VALUE 

RETADi+2 IS JCARD LONGER THAN KCARD 

7 NO-OK-MOVE OVER SEVEN ARGUMENTS 

D0NE1+1 CREATE RETURN ADDRESS 

SETUP J NOW 
•-• LOAD JCARD LENGTH TO [Rl 

KCARD(KNOWI«KCARD(KNOWI + OR - 
JCARD(JNOWI 
«-« LOAD KCARDIKNOW) 
»-* ADD OR SUBTRACT JCARD(JNOW) 
»-» STORE RESULT IN KCARDIKNOWI 

KNOW-KNOW+1 AND SEE IF JNOW IS 

GREATER THAN JLAST. IF NOT. 

JNOW-JNOW+1 AND GO BACK FOR 

MORE. 
-1 DECREMENT IR1 
KCRD3 GO BACK FOR MORE 

RESOLVE CARRIES GENERATED 

DURING OPERATION. 
CARRY GO TO CARRY SUBROUTINE 



PAGE 2 

C5P00580 
CSP00590 
CSP00600 
CSP00610 
CSP00620 
CSP00630 
CSP00640 
CSP00630 
CSP00660 
CSP00670 
CSP00680 
CSP00690 
CSP00700 
CSP00710 
CSP00720 
CSP00730 
CSP00740 
CSP00750 
CSP00760 
CSP00770 
CSP00780 
CSP00790 
CSPOOSOO 
CSP00810 
CSP00820 
CSP00830 
CSP00840 
CSP00850 
CSP00860 
CSP00870 
CSP00880 
CSP00890 
CSP0Q90O 
CSP00910 
CSP00920 
CSP00930 
CSP00940 
CSPO0950 
CSP00960 
CSP00970 
CSP00980 
CSP00990 
CSP01000 
CSP01010 
CSP01020 
CSP01030 
CSP01040 
CSP01050 
CSP01060 
CSP01070 

cspoioeo 

CSP01090 

cspoiioo 
cspomo 

CSP0U20 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICO MP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



0062 


0000 


KCRD1 DC 


0063 


0000 


Kl DC 


0064 1 


0087 


KLA51 DC 


006S 1 


oooe 


DC 



0066 01 4C18008A 
0068 01 4C100080 
006A 00 84000000 
006C 01 D480006B 



006E 00 65000000 

0070 7101 

0071 C02E 

0072 00 95000000 
0074 30 05000000 



0076 





TIFF 


0077 





7CF9 


0078 





C026 


0079 





F0FA 


007A 





D024 


0076 





70E4 



007C 00 65000000 
007E 00 4C000000 



0080 30 062534C0 
0082 0000 



0083 

0084 1 

0085 1 



0000 
0087 
00A0 



0086 00 65000000 

oose oo 60000000 



008A 

oose oi 

008D 
008E 01 
0090 01 
0092 01 

0094 

0095 01 
0097 01 
0099 
009A 01 
009C 
0090 
009E 



C013 
D480002B 

con 

4C280095 

C480003B 

4C280099 

70E7 

C4800O38 

4C28007C 

F003 

D4S00038 

70DF 

FFFF 

0000 



BSC 
BSC 
KCRD7 A 

STO 



COMP LDX 
«DX 
LD 
KCRD5 S 
KCRD6 STO 



MDX 

MDX 

LO 

EOfi 

STO 

MDX 

SAVE1 LOX 

D0NE1 BSC 

• 

ERR9 CALL 
KCRD2 OC 
K2 DC 
KLAS2 DC 
DC 
KLAS3 LDX 
ERA STX 



FIN LD 
STO 
LD 
BSC 
LD 
BSC 
MDX 
LD 
BSC 
EOR 
STO 
MDX 
HFFFF DC 
JSIGN DC 



NEG 



REV 



009F 


0000 


KSIGN 


DC 


00A0 


0009 


NINE 


DC 


00A1 


7107 


RETAD 


MDX 


00A2 


69DC 




STX 


00A3 01 


4C00008* 




BSC 


OOAS 00 


S 5000000 


OPR 


A 


00A7 






ORG 


00A6 00 


99000000 




S 


OOAS 






ORG 


00A7 00 


85000000 




A 


00 A9 






ORG 


OOAS 


C063 


OPO 


LO 



*-• KCARD ADDRESS 

• -• K ADDRESS 

KLAS3-U KLAST ADDRESS 

ADD ADDRESS TO HOLD ANY CARRY 

LET KNOW BE ANY RESULTING CARRY 
IF NEGATIVE! COMPLIMENT AND 
CHANGE THE SIGN OF KCARD. IF 
iEROi ALL DONE. IF POSITIVE) 
OVERFLOW ERROR. 
FIN.*- CHECK FOR ZERO-YES GO TO FIN 
ERR9.- NO-CHECK FOR OVERFLOW-YES ERR9 
•-• COMPLIMENT-ADO CARRY TO LOW 
KCRD7*1 ORDER AND STORE IT BACK 
COMPLIMENT - SUBTRACT EACH 
DIGIT FROM 9 AND CHANGE THE 
SIGN OF KCARD. 
*-* LOAD IR1 WITH LENGTH OF KCARD 
1 ADD 1 TO GET THE TRUE LENGTH 



NINE LOAD A NINE. 

•-• SUBTRACT KCARDCKNOWI 

•-« PUT BACK IN KCARDIKNOWI 

SEE IF KNOW IS GREATER THAN 

KLAST. IF NOT. KNOW-KNOW-.1 
-1 DECREMENT IR1 
COMP*3 GO BACK FOR MORE 
KSIGN 
KCRD6 

KSIGN SET SIGN OF KCARD 
AGAIN CHECK AGAIN FOR CARRIES 
•-• RESTORE IR1 
•-« RETURN TO CALLING PROGRAM 

ERROR - ERROR - OVERFLOW- - 

FILL FILL KCARD WITH NINES. 

•-• ADDRESS OF KCARO 

•-• ADDRESS OF K 

KLAS3-H ADDRESS KLAST 

NINE FILL CHARACTER 

«-» PICK UP KLAST VALUE 

•-» STORE VALUE AT NER 

RESTORE SIGNS ON JCARD AND 

KCARD FIELDS 
JSIGN PICK UP SIGN OF JCARD 
JPLUS'l AND RESTORE IT 
KSIGN PICK UP SIGN OF KCARD 
NEG.tZ CHECK FOR PLUS OR MINUS 
KPLUS-H PLUS-GET NEW SIGN AND 
REV.*Z REVERSE IT IF NEGATIVE 
5AVE1 POSITIVE-ALL OONE-GO TO EXIT.. 
KPLUS-U MINUS-GET NEW SIGN AND 
SAVE1.+2 GO TO EXIT IF NOT NEGATIVE 
HFFFF REVERSE THE SIGN 
KPLUS-H STORE IT BACK 

SAVE1 ALL DONE-GO TO EXIT 

/FFFF CONSTANT OF ALL BINARY ONES 
•-• SIGN OF JCARD 
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CSP01130 
CSP01140 
CSP01150 
CSP01160 
CSP01170 
CSP01180 
CSP01190 
CSP01200 
CSP01210 
CSP01220 
CSP01230 
CSP01240 
CSP01250 
CSP01260 
CSPO1270 
CSP01280 
CSP01290 
C5PO1300 
CSP01310 
CSP01320 
CSP01330 
CSP01340 
CSP01350 
CSP01360 
CSP01370 
CSP01380 
CSP01390 
CSP01400 
CSP01410 
CSP01420 
CSP01430 
CSP01440 
CSP01450 
CSP01460 
CSP01470 
CSP01480 
CSP01490 
CSP01300 
CSP01510 
CSP01520 
CSP01530 
CSP01540 
CSP01550 
CSP01560 
CSP01570 
CSP01580 
CSP01590 
CSP01600 
CSP01610 
CSP01620 
CSP01630 
CSP01640 
CSP01650 
CSP01660 
CSP01670 



END 



»-• SIGN OF KCARD 
» CONSTANT OF NINE 
1 7 MOVE OVER SEVEN ARGUMENTS 

1 00NE1*! CREATE RETURN ADORESS 
L KLAS3 GO TO KLAS3 
LI •-• ADD FOR ADD OR SUBTRACT OPERATN 

OPR*l RESET THE ADDRESS COUNTER 
LI •-• SUBTR FOR ADD OR SUBTR OPRATN 

OPR»2 RESET THE ADDRESS COUNTER 
LI ♦-• ADD FOR ADO OR SUBTRACT OPERATN 

OPR»3 RESET THE ADDRESS COUNTER 
X OPR-OP-1 FOR RESETING THE INSTRCTN 

AT OP TO ITS INITIAL STATE.. 
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CSP01680 
CSP01690 
CSP01700 
CSP01710 
CSP01720 
CSP01730 
CSP01740 
CSP01750 
CSP01760 
CSP01770 
CSP01780 
CSP01790 
CSP01800 
CSP01S10 



NO ERRORS IN ABOVE ASSEMBLY. 



// OUP 
•STORE 
34 IB OOOC 



WS UA ADD 



CSP01820 
CSP01S30 
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// ASM 

•• A1A3/A3A1 SUBROUTINES FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 
» NAME A1A3 
» LIST 

0000 01C41CC0 ENT 

» CALL 



110} 
(10) 



oooo 

0001 
0002 
0003 
0004 
0009 
0006 
0007 
0008 
0009 
OOOA 
OOOB 
OOOC 
0000 
OOOE 01 

0010 

0011 00 
0013 
001* 
0019 

0016 

0017 

0018 00 
001 A 
001B 00 
0010 00 
001F 
0020 
0021 
0022 
0023 
0024 
0029 
0026 
0027 00 

0029 00 
002B 00 
002D 
002E 01 

0030 

0031 

0032 

0033 



0000 

C002 

002A 

7007 

7021 

7000 

0000 

COFE 

D0F7 

COFB 

0022 

696S 

6A66 

6667 

69800000 

C100 

99800002 

0018 

D03F 

0044 

C103 

8006 

99800004 

DOOO 

C580OOO2 

99800001 

80FE 

O009 

C109 

9028 

0060 

D066 

7106 

6990 

69000000 

66000000 

C6000000 

7000 

4C280047 

1890 

A81B 

eoiB 

0002 



SW1 
SW2 
A3A1 



ENT 
CALL 



A1A3 DC 

LD 
STO 
MDX 
MDX 
MDX 
DC 
LO 
STO 
LD 
STO 
START STX 
STX 
STX 
LDX 
LD 
S 

STO 
STO 
STO 
LD 
A 
S 

STO 
LD 
S 
A 
STO 
LD 
S 

STO 
STO 
MDX 
STX 
KCARD LDX 
CNT LDX 
JCARD LD 
SWTCH MDX 
BSC 
SRT 
D 
A 
HOLD STO 



ONE 



A1A3 A1A3 SUBROUTINE ENTRY POINT 

A1A3IJCARD.J.JLAST.KCARD.K.ICHARI 
THE WORDS JCARD(J) THROUGH 
JCARD(JLAST) IN Al FORMAT ARE 
CRAMMED INTO KCARD IN A3 FORMAT. 
A3A1 A3A1 SUBROUTINE ENTRY POINT 

A3A1 1 JCARD. J. JLAST. KCARD .K.I CHAR I 
THE WORDS JCARD(J) THROUGH 
JCAROCJLASTI IN A3 FORMAT ARE 
UNCRAMMED INTO KCARD IN Al FORMAT. 
«-» ARGUMENT ADDRESS COMES IN HERE 
SW1 LOAD BRANCH TO ELSE 
SWTCH STORE BRANCH AT SWITCH 
START START COMPUTING 

X ELSE-SWTCH-1 BRANCH TO ELSE 

X NOP INSTRUCTION 

»-* ARGUMENT ADDRESS COMES IN HERE 
A3A1 PICK UP ARGUMENT ADDRESS AND 
A1A3 STORE IT IN A1A3 
SW2 LOAD NOP INSTRUCTION 
SWTCH STORE NOP AT SWITCH 

1 SAVE1+1 SAVE IR1 

2 SAVE2+1 SAVE IR2 

3 SAVE3+1 SAVE IR3 

II A1A3 PUT ARGUMENT ADDRESS IN IR1 
1 GET JCARD ADDRESS 

II 2 SUBTRACT JLAST VALUE 

JCARD+1 CREATE JCARDIJI ADDRESS 
0VR1+1 STORE JCARDIJI ADDRESS 
0VR2+1 STORE JCARDIJI ADDRESS 
1 3 GET KCARD ADDRESS 
ONE+l ADD CONSTANT OF 1 

II 4 SUBTRACT K VALUE 

KCARD+1 CREATE KCARDIKI ADDRESS 

II 2 GET JLAST VALUE 

II 1 SUBTRACT J VALUE 

ONE+l ADD CONSTANT OF 1 
CNT+1 CREATE FIELD WIDTH 
1 9 GET ICHAR ADDRESS 

040 SUBTRACT CONSTANT OF 40 
TABLE+1 CREATE TABLE END ADDRESS 
TCODE+1 STORE TABLE END ADDRESS 
1 6 ADJUST OVER 6 ARGUMENTS 
1 DONE 1+1 CREATE RETURN ADDRESS 

LI *-* PUT KCARD ADDRESS IN IR1 

L2 »-* PUT FIELO WIDTH IN IR2 

L2 *-» PICK UP JCARDIJI 

X SWITCH BETWEEN CRAM AND UNCM 

L MINUS. +Z TEST SIGN OF INTEGER 
16 SHIFT INTEGER TO EXTENSION 
D1600 DIVIDE BY 1600 
D20 ADJUST FIRST VALUE 
A3A1 SAVE FIRST CHARACTER VALUE 



CSP01840 
CSP0183O 
CSP0186O 
CSP01B70 

cspoieeo 

CSP01S90 

cspoi90o 

CSP01910 
CSP01920 
CSP01930 
CSP01940 
CSP01950 
CSP01960 
CSP01970 
CSP019S0 
CSP01990 
CSP02000 
CSP02010 
CSP02020 
CSP02030 
CSP02040 
CSP02050 
CSP02060 
CSP02070 
CSP02080 
CSP02090 
CSP02100 
CSP02110 
CSP02120 
CSP02130 
CSP02140 
CSP02190 
CSP02160 
CSP0217O 
CSP02180 
CSP02190 
CSP02200 
CSP02210 
CSP02220 
CSP02230 
CSP02240 
CSP02290 
CSP02260 
CSP02270 
CSP02280 
CSP02290 
CSP02300 
CSP02310 
CSP02320 
CSP02330 
CSP02340 
CSP02350 
CSPQ2360 
CSP02370 
CSP02380 
CSP0239O 
CSP02400 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYED 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



0034 


1810 




5RA 




0035 


AS15 









0036 


D0C9 




STO 




0037 


1090 




SLT 




003* 01 


4400007E 




BSI 


L 


00 3A 


D1FE 




STO 


1 


00 3B 


C0C4 




LD 




003C 01 


4400007E 




BSI 


L 


00 8E 


DiFF 




STO 


1 


00 3F 


C0C6 




LD 




0040 01 


4400007E 




BSI 


L 


0042 


D100 




STO 


1 


0043 


71FD 




MDX 


1 


0044 


72FF 




MDX 


2 


0043 


70E9 




MDX 




0046 


7029 




MDX 




0047 


8004 


MINUS 


A 




0048 


1890 




SRT 




0049 


A803 




D 




004A 


70EB 




MDX 




0048 


0028 


040 


DC 




004C 


7D00 


032K 


OC 




0040 


0640 


01600 


DC 




004E 


0014 


D20 


OC 




004F 


00B6 


ELSE 


STO 




0090 


72FF 




MOX 


2 


0091 


7001 




MDX 




0092 


7025 




MDX 




0093 00 


C6000000 


OVRl 


LD 


L2 


0039 


DOAA 




STO 




0096 


72FF 




MDX 


2 


0037 


7001 




MDX 




0058 


7021 




MDX 




0099 00 


C6000000 


0VR2 


LD 


L2 


005B 01 


44000087 


RET 


BSI 


L 


00 3D 


00CA 




STO 




00 »E 


C0A1 




LO 




003F 01 


44000087 




BSI 


L 


0061 


A0E9 




M 




0062 


1090 




SLT 




0063 


80C4 




A 




0064 


DOCS 




STO 




0069 


C0A0 




LD 




0066 01 


440000(7 




BSI 


L 


0068 


90E9 




S 




0069 


A0E3 




M 




006A 


1090 




SLT 




006B 


80BC 




A 




00 6C 


D100 




STO 


1 


006D 


71FF 




MDX 


1 


006E 


72FF 




MDX 


2 


006F 


70BB 




MDX 




0070 00 


65000000 


SAVE! 


LDX 


LI 


0072 00 


66000000 


SAVE2 


LDX 


L2 


0074 00 


67000000 


SAVE 3 


LDX 


L3 



0076 
0078 
0079 
00 7A 
0078 
00 7C 
0070 
00 7E 
OOTF 
0080 
0081 
0083 
0065 
0087 
0088 
0089 
00 6A 
00 8C 
0080 
00 8F 
0090 
0091 
0092 
0094 
0095 
00 96 
0097 
0098 



00 4COO00O0 
C004 
0086 
C002 
7201 
70DE 
4040 
0000 
809E 
0001 
00 67000000 

00 C7000000 

01 4C80007E 
0000 

D0F3 
6328 
00 C7000000 

F0F1 

01 4C200094 
6BEE 

COED 

908C 

01 4C800087 
73FF 

70F4 
C0E6 
70F0 



D0NE1 BSC 

FILL! LO 
STO 

FILL2 LO 
MDX 
MOX 

H4040 OC 

DECOD OC 
A 
STO 

PLACE LDX 

TABLE LD 
BSC 

CODE DC 
STO 
LDX 

TCODE LO 
EOR 
BSC 

AWAY STX 
LD 
S 
BSC 

OUT MOX 
MDX 
LD 
MDX 
END 
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16 ZERO ACCUMULATOR CSP02410 

040 DIVIDE BY 40 CSP02420 

A1A3 SAVE SECOND CHARACTER VALUE CSP02430 
16 SHIFT THIRD CHAR VALUE TO ACCUM CSP02440 

DECOD DECODE THIRD CHARACTER CSP02430 

-2 STORE THIRD CHARACTER CSP02460 

A1A3 SET SECOND CHARACTER CSP02470 

DECOD DECODE SECOND CHARACTER CSP02480 

-1 STORE SECOND CHARACTER CSP02490 

A3A1 SET FIRST CHARACTER CSP0250O 

DECOD DECODE FIRST CHARACTER CSP02510 

STORE FIRST CHARACTER CSP02320 

-3 DECREMENT Al OUT ARRAY CSP02530 

-1 DECREMENT FIELD WIDTH CSP02940 

JCARD FIELD WIDTH IS NOT ZERO CSP02350 

SAVE1 SO TO RESTORE AND RETURN CSP02960 

D32K ADJUST FOR NEGATIVE INTEGER CSP02970 

16 SHIFT INTEGER TO EXTENSION CSP02580 

D1600 DIVIDE BY 1600 CSP02590 
HOLD GO TO GET THE REMAINING INTEGERS CSP02600 

40 CONSTANT OF 40 CSP02610 

32000 CONSTANT OF 32000 CSP02620 

1600 CONSTANT OF 1600 CSP02630 

20 CONSTANT OF 20 CSP02640 

A3A1 STORE FIRST Al CHARACTER CSP02650 

-1 DECREMENT FIELD WIDTH CSP02660 

0VR1 GO TO GET NEXT CHARACTER CSP02670 
FILL1 LAST CHARACTER-FILL WITH BLANK CSP02680 

L2 •-• GET SECOND CHARACTER CSP02690 

A1A3 STORE SECONO CHARACTER CSP02700 

-1 DECREMENT FIELD WIDTH CSP02710 

0VR2 GO TO GET NEXT CHARACTER CSP02720 

FILL2 LAST CHARACTER-FILL BLANK CSP02730 

*-* GET THIRD CHARACTER CSP02740 

CODE CODE CHARACTER TO NUMBER CSP02790 
KCARD61 SAVE NUMBR OF THIRD CHARACTER CSP02760 

A1A3 GET SECOND CHARACTER CSP0277O 

CODE CODE SECOND CHARACTER CSP02780 

040 MULTIPLY BY 40 AND CSP02790 

16 SHIFT TO ACCUMULATOR CSP0280O 

KCARD+1 ADD NUMBERITHIRDI AND CSP02810 

KCARO+l SAVE RESULTING INTEGER CSP02S20 

A3A1 GET FIRST CHARACTER CSP02830 

CODE CODE FIRST CHARACTER CSP02840 

D20 SUBTRACT 20 CSP02850 

D1600 MULTIPLY BY 1600 CSP02660 

16 SHIFT TO ACCUMULATOR CSP02870 

KCARD+1 ADD IN PREVIOUS RESULT CSP02880 

STORE IN A3 ARRAY CSP02890 

-1 NEXT WORD IN A3 ARRAY CSP02900 

-1 DECREMENT FIELD WIDTH CSP02910 

JCARD GET MORE Al CHARACTERS CSP02920 

•-• RESTORE IR1 CSP02930 

«-• RESTORE 1R2 CSP02940 

•-• RESTORE IR3 CSP02950 



L «-• RETURN TO CALLING PROGRAM 
H4040 FILL WITH TWO BLANKS 
A1A3 STORE SECOND CHARACTER BLANK 
H4040 FILL WITH ONE BLANK 

2 1 SET IR1 TO 1 

RET GO TO CODE ROUTINE 

/4040 CONSTANT OF Al BLANK 

•-• DECODE RETURN ADDRESS GOES HERE 

ONEfl ADD ONE TO NUMBER GIVING 

PLACE+1 SUBSCRIPT OF TABLE AND SAVE 

L3 »-• LOAD IR3 WITH SUBSCRIPT OF TABLE 

L3 •-• GET Al CHARACTER 

1 DECOD RETURN 

•-• CODE RETURN ADDRESS GOES HERE 
DECOD SAVE THE CHARACTER TO BE CODED 

3 40 LOAD IR3 WITH THE TABLE LENGTH-40 
L3 •-• LOAD CHARACTER FROM ICHAR ARRAY 

DECOD ZERO ACCUMULATOR IF MATCH 
L OUT.Z GO TO PUT IF NOT ZERO 
3 DECOD SAVE SUBSCRIPT OF MATCH 

DECOD LOAD SUBSCRIPT 

ONE+l SUBTRACT ONE GIVING NUMBER 
I CODE RETURN 
3 -1 DECREMENT THROUGH THE TABLE-ICHAR 

TCODE GO TRY AGAIN 

H4040 NOT IN THE TABLE - LOAD A BLANK 

CODEfl GO BACK TO CODE THE BLANK.... 
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CSP02960 
CSP02970 
CSP02980 
CSP02990 
CSP03000 
CSP03010 
CSP03020 
CSP03030 
CSP03040 
CSP03050 
CSP03060 
CSP03070 
CSPO308O 
CSP03090 
CSP03100 
CSP03110 
CSP03120 
CSP03130 
CSP03140 
CSP03150 
CSP03160 
CSP03170 
CSP03180 
CSPO3190 
CSP03200 
CSP03210 
CSP03220 
C5P03230 



NO ERRORS IN ABOVE ASSEMBLY. 



// OUP 

•STORE ws UA A1A3 

3332 OOOA 



CSP03240 
CSP03250 
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// ASM 

«« A1DCC SUBROUTINE 

* NAME AlOEC 

• LIST 

OOOl 01C44143 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



I ID) 
(10) 



0000 

0001 

0002 

0003 01 

0005 

0006 

0007 00 
0009 
OOOA 
OOOB 
OOOC 
OOOD 
OOOE 
OOOF 01 

0011 

0012 00 



0014 
0019 
0016 
0017 
0018 
0019 
001A 
001B 



001C 30 

001E 
001F 

0020 1 

0021 1 



0004 

0000 

6941 

65800001 

C100 

0017 

95800002 

001B 

D02C 

8007 

D033 

C102 

0010 

C480001F 

DOEF 

95800001 

80FE 

4808 

COFC 

DOOB 

C103 

D016 

7104 

692A 

15A56545 

0000 

0000 

OOOO 

001E 



0022 00 65000000 



0024 00 
0026 01 

0028 

0029 01 

002B 
002C 
0020 
002E 
002F 00 

0031 

0032 

0033 01 



C5000000 
4C100032 
901E 
4C100035 

69F7 

C0D4 

90F5 

80E4 

04000000 

7006 

9019 

4C20002B 



0035 1608 

0036 00 05000000 



0038 

0039 



71FF 
70EA 



FOUR 
AlOEC 



JCRD1 
JLAS1 



DC 

DC 

STX 

LDX 

LO 

STO 

S 

STO 

STO 

A 

STO 

LO 

STO 

LO 

STO 

S 

A 

BSC 

LD 

STO 

LO 

STO 

MDX 

STX 

CALL 
DC 

DC 
DC 

DC 



COUNT LDX LI 



LD 
BSC 
S 
BSC 

STX 

LD 

S 

A 

STO 

MDX 

S 

BSC 



ERA 
POS 



AlOEC A1DEC SUBROUTINE ENTRY POINT 
CALL A1DECIJCARD.J.JLAST.NERI 
THE WORDS JCARDIJ) THROU&H 
JCARDULASTI ARE CONVERTED FROM 
Al FORMAT TO Dl FORMAT AND THE 
ORIGINAL DATA IS REPLACED BY THE 
CONVERTED DATA. 
4 CONSTANT OF FOUR 
•-• AROUMENT ADDRESS COMES IN HERE 
1 SAVE1+1 SAVE IR1 
U A1DEC PUT ARGUMENT ADDRESS IN IR1 
1 GET JCARD ADDRESS 

JCRD1 SETUP JCARD ADDRESS FOR NZONE 
2 SUBTRACT JLAST VALUE 
PICK+1 PLACE LOAD ADDRESS FOR CONVRS 
PUT+1 PLACE STORE ADDRESS FOR CONVRS 
ONE + 1 ADD CONSTANT OF ONE 
LAST+1 PLACE ADDRESS OF SIGN POSITON 
1 2 GET JLAST ADDRESS 

JLAS1 SETUP JLAST ADDRESS FOR NZONE 
I JLAS1 GET JLAST VALUE AND 

AlOEC SAVE IT AT A1DEC 
U 1 SUBTRACT J VALUE 

ONE+1 ADD CONSTANT OF ONE 
♦ CHECK FIELO WIDTH 
ONE+1 ZERO OR NEGATIVE-MAKE IT ONE 
COUNT+1 OK-SAVE WIDTH IN COUNT 
1 3 GET NER ADDRESS 

ERA+1 SAVE IT 
1 4 MOVE OVER FOUR ARGUMENTS 
1 D0NE1+1 CREATE RETURN ADDRESS 
REMOVE AND SAVE THE SIGN 
NZONE REMOVE THE ZONE OVER LOW ORDER 
*-» ADDRESS OF JCARD 
•-• ADDRESS OF JLAST 
FOUR ADDRESS OF CONSTANT OF FOUR 
JCRD1 ADDRESS OF OLD ZONE 
JNOW-J 

LOAD IRl WITH FIELO WIDTH 
JTEST«JCARD(JNOW) 
LI »-» PICK UP JCARDUNOW) AND 
L POS>- CHECK IT AGAINST ZERO 

ZERO NEGATIVE-IS IT LESS THAN 
L OKi- AN EBCDIC ZERO 
NER-JNOW 
1 COUNT+1 YES - ERROR 

A1DEC COMPUTE THE SUBSCRIPT 
COUNT+1 OF THIS CHARACTER IN 
ONE+1 THE ARRAY AND 
L •-« STORE THE SUBSCRIPT AT NER 
MORE GO GET THE NEXT CHARACTER 
BLANK NOT NEGATIVE - IS IT AN 
L ERRiZ EBCDIC BLANK 



II 



OK 

PUT 



SRA 
STO 



MORE MDX 
MDX 



003A 


C0E3 




LD 




003B 


90CC 




S 




003C 01 


4C200043 




BSC 


L 


003E 


9004 




S 




00 3F 00 


F4000000 


LAST 


EOR 


L 


0041 01 


04800040 




STO 


I 


0043 00 


63000000 


SAVE1 


LDX 


LI 


0045 00 


4C00OOOO 


D0NE1 


BSC 


L 


0047 


F040 


ZERO 


DC 




0048 


4040 


BLANK 


DC 




004A 






END 





CSP03260 
CSP03270 

CSP03280 
CSP03290 

CSP03300 
CSP03310 
CSP03320 
CSP03330 
CSP03340 
CSP03350 
CSP03360 
CSP03370 
CSP03380 
CSP03390 
CSP03400 
CSP03410 
CSP03420 
CSP03430 
CSP03440 
CSP03450 
CSP03460 
CSP03470 
CSP03480 
CSP03490 
CSP03500 
CSP03510 
CSP03520 
CSP03530 
CSP03540 
CSP03550 
CSP03360 
CSP03570 
CSP03580 
CSP03590 
CSP03600 
CSP03610 
CSP03620 
CSP03630 
CSP03640 
CSP03650 
CSP03660 
CSP03670 
CSP03680 
CSP03690 
CSP03700 
CSP03710 
CSP03720 
CSP03730 
CSP03740 
CSP03750 
CSP03760 
CSP03770 
CSP03780 
CSP03790 
CSP03800 
CSP03310 
CSP03S20 



JTEST + 4032 IS NOW IN ACCUM 
SHIFT 8 IS SAME AS DIVIDE BY 256 
8 EITHER BLANK OR DIGIT - PUT 
*-« THE FOUR BITS OF DECIMAL BACK 

SEE IF JNOW IS LESS THAN JLAST. 
IF YES. JNON-JNOW+1 AND GO BACK 
FOR MORE. IF NO. SET UP THE 
SIGN. 
-1 DECREMENT THE FIELO WIDTH 
PICK GO BACK FOR MORE 

WAS THE ORIGINAL SIGN INDICATION 
TWO. IF NOT. ALL DONE. IF YES 
MAKE THE SIGN NEGATIVE. 
JCARD I JLAST >■- JCARDULASTI - 1 
JCRD1 PICK UP THE OLD ZONE AND 
TWO+1 CHECK IT AGAINST TWO 
SAVE1.Z IF NO MATCH GO TO EXIT 
ONE+1 IF MATCH. MAKE THE 
»-« SIGN NEGATIVEILOW ORDER) AND 
LAST+1 STORE IT BACK 

EXIT.. 

»-« RESTORE IRl 
»-« RETURN TO CALLING PROGRAM 
/F040 CONSTANT OF EBCDIC ZERO 
/4040 CONSTANT OF EBCDIC BLANK 
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CSP03830 
CSP03640 
CSP03850 
CSP03860 
CSP03870 
CSP03880 
CSP03890 
CSP03900 
CSP03910 
CSP03920 
CSP03930 
CSP03940 
CSP03950 
CSP03960 
CSP03970 
CSP03980 
CSP03990 
CSP04000 
CSP04010 
CSP04020 
CSP04030 
CSP04040 
CSP04050 
CSP04060 
CSP04070 
CSP04080 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
♦STORE 
333C 0009 



WS UA AlOEC 



CSP04090 
CSP04100 



-157- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICO MP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 

»• CARRY SUBROUTINE 

» NAME CARRY 

• LIST 

0000 03059668 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 
(IDI 



0000 

0001 

0002 01 

0004 

0005 00 

0007 

0008 

0009 00 
OO0B 00 
000D 
0O0E 
000F 

0010 

0011 

0012 

0013 

0014 

0015 



0000 

6930 

65800000 

C100 

95800002 

6004 

0011 

C5800002 

95800001 

80FE 

4808 

COFC 

D007 

C103 

D01D 

7104 

691F 

10A0 



0016 D0E9 

0017 00 65000000 



0027 1090 

0028 01 04B0001A 
002A 01 7401001A 



CARRY DC 
STX 
LDX 
LD 
S 
A 

STO 
LD 

ONE S 
A 

BSC 
LD 
STO 
LO 
STO 
MDX 
STX 
SLT 

STO 

COUNT LDX 



0019 


00 


C40OOOOO 


SRCE 


LD 


001B 





80E4 




A 


001C 





1890 




SRT 


OOID 





A817 




D 


001E 





OOEl 


• 


STO 


00 IF 





1090 


• 


SLT 


0020 


01 


4C10002S 




BSC 


0022 





8012 




A 


0023 





1890 




SRT 


0024 





COOB 




LD 


0029 





90E6 




S 


0026 





D0D9 




STO 



CARRY CARRY SUBROUTINE ENTRY POINT 

CALL CARRYIJCARD.J.JLAST.KAHRYI 
THE WORDS JCARD(J) THROUGH 
JCARDULASTI ARE CHECKED TO SEE 
THAT THEY ARE BETWEEN 2ER0 AND 
NINEt IF THEY ARE NOT. THE 
UNITS DISIT REMAINS AND THE TENS 
DIGIT IS TREATED AS A CARRY TO 
THE NEXT WORD. 
*-« ARGUMENT ADDRESS COMES IN HERE 
1 5AVE1+1 SAVE IR1 
II CARRY PUT ARGUMENT ADDRESS IN IR1 

10 GET JCARD ADDRESS 
II 2 SUBTRACT JLAST VALUE 
ONE+1 ADD CONSTANT OF ONE 
SRCE+1 CREATE JCARDULASTI ADDRESS 
II 2 GET JLAST VALUE 
II 1 SUBTRACT J VALUE 

ONE+1 ADD CONSTANT OF ONE 
+ CHECK FIELD WIDTH 
ONE+1 ZERO OR NEGATIVE-MAKE IT ONE 
COUNT+1 OK-SAVE WIDTH IN COUNT 
1 3 GET KARRY ADDRESS 

OVF+1 AND SAVE IT 
1 4 MOVE OVER FOUR ARGUMENTS 
1 D0NE1+1 CREATE RETURN ADDRESS 

32 CLEAR THE ACCUMULATOR AND EXTEN 

LET CARRY BE THE SAME AS NCARY 
CARRY SET NCARY TO ZERO 

LOAD IR1 WITH THE FIELD WIDTH 
THE NEXT INSTRUCTION STARTS OUT 
BY PICKING UP JCARD(JLAST). 
THE SUBSCRIPT IS DECREMENTED BY 
THE INSTRUCTION AFTER POSZ. 
THE CALCULATIONS ARE.. 
JTEST-JCAR0(JNOW!+NCARY 
NCARY-JTEST/10 
JTEST-JTEST-10«NCARY 
«-• PICK UP JCAROIJNOw) 
CARRY ADD THE PREVIOUS CARRY TO IT 
16 SHIFT THE ACCUM TO THE EXTENTON 
TEN DIVIDE BY TEN AND 
CARRY STORE THE QUOTIENT AT NCARY 
THE QUOTIENT IS THE GENERATEO 

16 PUT REMAINDER IN ACCUMULATOR AN 
POSZ.- CHECK TO SEE IF NEGATIVE-NO- 
GO TO POSZ 

TEN YES - COMPLIMENT BY ADDING TEN 
1* STORE TEMPORARILY IN EXTENTION 
CARRY LOAD NCARY 
ONE+1 AND SUBTRACT 
CARRY ONE FROM IT 



LI »-• 



16 



POSZ STO I 



002C 
002D 


71FF 
70ES 


# 
OVF 


MDX 
MDX 


1 -1 
SRCI 


002E 
002F 00 


C0D1 
04000000 


LD 
STO 


CARI 
L •-• 


0031 00 
0033 00 

0035 
00 36 


65000000 

4COOOOO0 
OOOA 


SAVE1 
DON El 
TEN 


LDX 
BSC 
DC 

END 


LI «-♦ 
L •-* 

10 



JCAR0UNOWI-JTE5T 

SHIFT COMPLIMENTED REMAINDER 

BACK TO ACCUMULATOR 
SRCE+1 AND STORE IN RESULT 

JNOW-JNOW-1 
SRCE+1. 1 GO TO NEXT DIGIT OF JCARD 

if jnow is less Than j. all 

DONE. OTHERWISE. GET THE NEXT 

DIGIT. 

DECREMENT THE FIELD WIDTH 
SRCE GO BACK FOR NEXT DIGIT 

KARRY»NCARY 
CARRY ALL DONE - PICK UP ANY 

GENERATEO CARRY ANi> STORE IT 

AR KARRY. EXIT... 

RESTORE IR1 

RETURN TO CALLING PROGRAM 

CONSTANT OF TEN 



CSP04110 
CSP04120 
CSP04130 
CSP04140 
CSP04150 
CSP04160 
CSP04170 
CSP04180 
CSP04190 
CSP04200 
CSP04210 
CSP04220 
CSP04230 
CSP04240 
CSP04250 
CSP04260 
CSP04270 
CSP042S0 
CSP04290 
CSP04300 
CSP04310 
CSP0432O 
CSP04330 
CSP04340 
CSP04350 
CSP04360 
CSP04370 
CSP04380 
CSP04390 
CSP04400 
CSP04410 
CSP04420 
CSP04430 
CSP04440 
CSP04450 
CSP04460 
CSP04470 
CSP04430 
CSP04490 
CSP04500 
CSP04510 
CSP04520 
CSP04530 
CSP04340 
CSP04550 
CSP04560 
CSP04570 
CSP04580 
CSP04590 
CSP04600 
CSP04610 
CSP04620 
CSP04630 
CSP04640 
CSP04650 
CSP0466O 
CSP04670 
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CSP04680 
CSP04690 
CSP04700 
CSP04710 
CSP04720 
CSP04730 
CSP04740 
CSP04750 
CSP04760 
CSP04770 
CSP047S0 
CSP04790 
CSP04600 
CSP04810 
CSP04620 
CSP04830 
CSP04840 
CSP04950 
CSP04860 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
3341 0004 



WS UA CARRY 



CSP04670 

CSP04880 



-158- 



// ASM 

*» DECA1 SUBROUTINE 

* NAME DECA1 

* LIST 

0000 04143071 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 
(ID) 



0000 





0000 


DECA1 DC 




0001 





6942 


STX 


1 


0002 


01 


69SOOO00 


LDX 


11 


0004 





C100 


LD 


1 


0009 





0039 


STO 




0006 


00 


99800002 


TWO S 


11 


oooe 





0020 


STO 




0009 





D030 


STO 




OOOA 





6007 


A 




OOOB 





0010 


STO 




OOOC 





C102 


LD 


1 


0000 





0032 


STO 




OOOE 


01 


C4800040 


LD 


I 


0010 





DOEF 


STO 




0011 


00 


99600001 


ONE S 


11 


0013 





80FE 


A 




0014 





4806 


BSC 




0019 





COFC 


LD 




0016 





0010 


STO 




0017 





C103 


LD 


1 


0018 





D016 


STO 




0019 





7104 


MDX 


1 


001A 





692B 


STX 


1 



001B 


00 


C4000000 


TEST 


LD 


L 


001D 


01 


4C280021 




BSC 


L 


00 IF 





C027 




LD 




0020 





7004 




MDX 




0021 





F026 


NEG 


EOR 




0022 


01 


D480001C 




STO 


I 


0024 





C0E2 




LD 




0029 





D0F6 


SO 


STO 




0026 


00 


69000000 


COUNT 
PICK 


LDX 


LI 


0028 


00 


C9000000 


LD 


LI 


002A 


01 


4C100033 




BSC 


L 


002C 





69FA 


ERR 


STX 


1 


0020 





C002 




LD 




002E 





90F6 




S 




00 2F 





80E2 




A 




0030 


00 


D4000000 


ERA 


STO 


L 



0032 


7008 




MDX 


0033 


9015 


OK 


5 


0034 01 


4C10002C 




BSC 


0036 


8012 




A 


0037 


1008 




SLA 


0038 


E811 




OR 


0039 00 


09000000 


PUT 

* 

* 

# 

MORE 


STO 


003B 


71FF 


MDX 


003C 


70EB 




MDX 


00 3D 30 


15A96943 




CALL 


003F 


0000 


JCRD1 


DC 


0040 


0000 


JLAS1 


DC 


0041 1 


001C 




DC 



0042 1 003F 



0ECA1 DECA1 SUBROUTINE ENTRY POINT 
CALL OECAKJCARD.J.JLAST.NERI 
THE WORDS JCARDIJ) THROUGH 
JCARDULAST) ARE CONVERTED FROM 
Dl FORMAT TO Al FORMAT AND THE 
ORIGINAL DATA IS REPLACED BY THE 
CONVERTED DATA. 

*-* ARGUMENT ADDRESS COMES IN HERE 

SAVE1+1 SAVE IR1 
II DECA1 PUT ARGUMENT ADDRESS IN IR1 

GET JCARD ADDRESS 
JCRD1 SETUP JCARD ADDRESS FOR NZONE 
2 SUBTRACT JLAST VALUE 
PICK+1 PLACE LOAD ADDRESS FOR CONVRSN 
PUT+1 PLACE STORE ADDRESS FOR CONVRSN 
ONE+1 ADD CONSTANT OF ONE 
TEST+l CREATE JCAROIJLASTI ADDRESS 

2 GET JLAST ADDRESS 
JLAS1 SETUP JLAST ADDRESS FOR NZONE 
JLAS1 GET JLAST VALUE AND 
DECA1 SAVE IT AT DECA1 

1 SUBTRACT J VALUE 
ONE+1 ADD CONSTANT OF ONE 
+ CHECK FIELD WIDTH 
ONE+1 NEGATIVE OR ZERO-MAKE IT ONE 
COUNT+1 OK-SAVE WIDTH IN COUNT 

3 GET NER ADDRESS 
ERA+1 SAVE IT 

4 MOVE OVER FOUR ARGUMENTS 
D0NE1+1 CREATE RETURN ADDRESS 

CHECK THE SIGN OF JCARD. IF 

NEGATIVE! SET JSIGN-2. AND MAKE 

IT POSITIVE. OTHERWISE. SET 

JSIGN»4 
»-* GET JCARD (JLAST I 
NEG.+2 CHECK FOR NEGATIVE 
FOUR NO - LOAD FOUR 
GO SKIP OVER NEGATIVE PROCESSING 
HFFFF YES - CHANGE SIGN TO POSITIVE 
TEST+1 RESTORE SIGN AS POSITIVE 
TWO+1 LOAD TWO 
TEST+1 STORE ACCUMULATOR TO SAVE SIGN 

JNOW-J 
•-« LOAD IR1 WITH FIELD WIDTH 

JTEST-JCARDIJNOW) 
*-» PICK UP JCARD (JNOW) 
OK.- AND CHECK IT AGAINST ZERO 

NER»JNOW 
COUNT+1 LESS THAN - ERROR 
DECA1 CALCULATE THE SUBSCRIPT 
COUNT+1 OF THIS DIGIT 
ONE+1 AND STORE 
*-« IT AT NER 



0043 00 


65000000 


SAVE1 


LDX 


LI 


0043 00 


4COOO000 


D0NE1 


BSC 


L 


0047 


0004 


FOUR 


DC 




0048 


FFFF 


HFFFF 


DC 




0049 


OOOA 


TEN 


DC 




004A 


F040 


ZERO 


DC 




004C 






END 





CSP04890 
CSP04900 
CSP04910 
CSP04920 
CSP04930 
CSP04940 
CSP04950 
CSP04960 
CSP04970 
CSP04980 
CSP04990 
CSPOSOOO 
CSP09010 
CSP05020 
CSPOS030 
CSP05040 
CSP09050 
CSP09060 
CSP03070 
CSP03080 
CSP03090 
CSP05100 
CSP05U0 
CSP03120 
CSP05130 
CSP05140 
CSP05150 
CSP09160 
CSP05170 
CSP09180 
CSP05190 
CSP05200 
CSP09210 
CSP09220 
CSP09230 
CSP05240 
CSP05250 
CSP05260 
CSP0S270 
CSP09280 
CSP05290 
CSP09300 
CSP05310 
CSP09320 
CSP0S330 
CSP09340 
CSP09350 
CSP0536O 
CSP05370 
CSP05380 
CSP05390 
CSP03400 
CSP09410 
CSP03420 
CSP03430 
CSP0S440 
CSP054S0 



MORE GET NEXT DIGIT 

TEN NOT LESS - COMPARE IT TO 

ERR.- CONSTANT OF TEN-NOT LESS GO TO 

TEN LESS - ADD TEN BACK 

8 SHIFT THE FOUR BITS OF DECIMAL 

ZERO IN PLACE AND CREATE Al 

»-« CHARACTER-STORE IN JCARDUNOWI 

SEE IF JNOW IS LESS THAN JLAST. 

IF YES > JNOW-JNOW+1 AND GO BACK 

FOR MORE. IF NO. SETUP THE SIGN 
-1 DECREMENT THE FIELD WIDTH 
PICK GO BACK FOR MORE 
NZONE NZONE ROUTINE TO PLACE SIGN 
»-* ADDRESS OF JCARD 
•-» ADDRESS OF JLAST 
TEST+1 ADDRESS OF SIGN INDICATOR TO 

USE 
JCRD1 ADDRESS OF SIGN INDICATOR FOR 

OLD SI-GN 

EXIT 
•-» RESTORE IR1 
»-« RETURN TO CALLING PROGRAM 
4 CONSTANT OF FOUR 
/FFFF CONSTANT OF ALL BINARY ONES 
10 CONSTANT OF TEN 
/F040 CONSTANT OF EBCDIC ZERO 
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CSP05460 
CSP09470 
CSP05480 
CSP0549O 
CSP05500 
CSP0551O 
CSP05520 
CSP0S530 
CSP05940 
CSP05550 
CSP05960 
CSP05970 
CSP05960 
CSP05990 
CSP05600 
CSP05610 
CSP05620 
CSP05630 
CSP05640 
CSP05650 
CSP09660 
CSP05670 
CSP0568O 
CSP05690 
CSP05700 
CSP0S710 
CSP05720 
CSP09730 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
3345 0006 



WS UA 0ECA1 



CSP05740 
CSP05790 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 

•• DIV SUBROUTINE 

• NAME DIV 

* LIST 

0000 0*265000 



0000 

0001 

0002 

0003 
000* 01 

0006 

0007 00 

0009 
OO0A 01 
000C 
O0OD 

0O0E 00 

0010 00 

0012 

0013 
001* 
0019 

0016 

0017 

ooie oo 

00 1A 
001B 
001C 

ooio o 



0000 

6970 

6A71 

6B72 

65600000 

C100 

95000002 

D04C 

D40000AD 

9004 

D011 

C5800002 

95600001 

80FE 

4808 

C0FC 

DOSE 

C103 

D037 

95800005 

80F6 

000D 

7107 

695A 



001E 
0020 
0021 
0023 
002* 
0026 
0027 
0026 
002A 
002B 
002D 
002E 
0030 
0031 
0032 
0033 
00 34 



00 C4000000 

OODF 

01 4C100027 
F039 

01 D480001F 
C036 
1890 
00 C4000000 

004F 

01 *C100033 

F02F 

01 0*800029 
1090 

F02B 
7001 
1090 
0046 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 110) 

(ID) 

ENT DIV DIVIDE SUBROUTINE ENTRY POINT 

* CALL DIVIJCARDtJ.JLASTiKCARDiKiKLASTiNER) 

* THE WOROS JCARD(J) THROUGH 

» JCAROIJLASTI ARE DIVIDED INTO 

* THE WORDS KCARDIKI THR0U6H 

« KCARDIKLAST). THE KCARD FIELD 

* IS EXTENDED TO THE LEFT AND 

* CONTAINS THE QUOTIENT AND 

* REMAINDER. 

DIV DC »-» AR6UMENT ADDRESS COMES IN HERE 

STX 1 SAVE1+1 SAVE IR1 

STX 2 SAVE2+1 SAVE IR2 

STX 3 SAVE3+1 SAVE IR3 

LDX II DIV PUT ARGUMENT ADDRESS IN IR1 

LD 10 SET JCARD ADDRESS 

S II 2 SUBTRACT JLAST VALUE 

STO SRCH+1 STORE END OF JCARD ADDRESS 

STO L MULT 1*1 FOR SEARCH AND MULTIPLICATION 

A ONE+l ADD CONSTANT OF ONE 

STO SGNJ+1 CREATE JCAROIJLASTI ADDRESS 

* JSPAN"JLAST-J+1 
TWO LD II 2 GET JLAST VALUE 
ONE S II 1 SUBTRACT J VALUE 

A ONE+1 ADD CONSTANT OF ONE 

BSC + CHECK FIELD WIOTH 

LD ONE+l NEGATIVE OR ZERO-MAKE IT ONE 

STO SRCHT+1 STORE COUNT FOR SEARCH 

LD 13 GET KCARD ADDRESS 

STO KCRD1 SAVE FOR FILL 

S II 5 SUBTRACT KLAST VALUE 

A ONES1 ADD CONSTANT OF ONE 

STO SGNK+1 CREATE KCARD (KLAST I ADORESS 

MDX 1 7 MOVE OVER SEVEN ARGUMENTS 

STX 1 DONE1+1 CREATE RETURN ADDRESS 

* CLEAR AND SAVE THE SIGNS ON THE 

* JCARD AND THE KCARD FIELDS 
SGNJ LD L *-* PICKUP THE SIGN OF JCARO 

STO DIV SAVE IT IN DIV 

BSC L JPLUSt- IF NOT NEGATIVE-GO TO JPLUS 

EOR HFFFF+1 NEGATIVE-MAKE IT POSITIVE 

STO I SGNJ+1 PUT BACK IN JCAROIJLASTI 

LD HFFFF+1 LOAD A MINUS ONE 

JPLUS 5RT 16 SAVE IN EXTENSION 

SGNK LD L •-• PICKUP THE SIGN OF KCARD 

STO KSIGN SAVE IT IN KSIGN 

BSC L KPLUS.- IF NOT NEGATIVE-GO TO KPLUS 

EOR HFFFF+1 NEGATIVE-MAKE IT POSITIVE 

STO I SGNK+1 PUT BACK IN KCARDIKLAST) 

SLT 16 GET SIGN OF JCARD 

EOR HFFFF+1 CHANGE IT 

MDX OVRK SKIP NEXT INSTRUCTION 

KPLUS SLT 16 GET SIGN OF JCARD 

OVRK STO OSIGN STORE FOR SIGN OF OUOTIENT 



CSP05760 

CSP05770 

CSP05760 

CSP05790 

CSP03800 

CSP05810 

CSP05820 

CSP05830 

CSP05840 

CSP05850 

CSP05860 

CSP05870 

CSP0568O 

CSP05690 

CSP05900 

CSP05910 

CSP05920 

CSP05930 

CSP05940 

CSP05950 

CSP05960 

CSP05970 

CSP05980 

CSP05990 

CSP06000 

CSP06010 

CSP06020 

CSP06030 

CSP06040 

CSP0605O 

CSP06060 

CSP06070 

CSP06080 

CSP06090 

CSP06100 

CSP06110 

CSP06120 

CSP06130 

CSP06140 

CSP0615O 

CSP06160 

CSP06170 

CSP06180 

CSP06190 

CSP06200 

CSP06210 

CSP06220 

CSP06230 

CSP06240 

CSP06250 

CSP06260 

CSP06270 

CSP06260 

CSP06290 

CSP06300 

CSP06310 

CSP06320 
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0039 


00 


C960FFFD 




LO 


11 


0037 





8029 




A 




0038 





0040 




STO 




0039 





80D7 




A 




003A 





9019 




S 




0030 





D041 




STO 




003C 


00 


C980FFFE 


MTWO 


LO 


11 


003E 





0040 


ft 


STO 




003F 





C00F 


ft 


LO 




0040 





903E 




S 




0041 





8012 




A 




0042 





80CE 




A 




0043 


01 


040000DF 




STO 


L 


0049 





C039 




LD 




0046 





9032 




S 




0047 





900C 




S 




0046 


01 


4C2B00SB 




BSC 


L 


004A 





C032 




LD 




00 4B 


01 


4C08009B 


ft 


BSC 


L 


0040 


30 


062934C0 


ft 


CALL 




004F 





0000 


KCRD1 


DC 




0090 


1 


007D 




DC 




0091 


1 


0079 




DC 




0092 


1 


007C 


* 
SRCHT 


DC 




0093 


00 


66000000 


LDX 


L2 


0095 


00 


C6000000 


SRCH 


LD 


L2 



0097 01 4C300080 



0099 
005A 



72FF 
70FA 



009B C023 
005C 00 D580FFFF 

005E C0A1 
009F 01 D460001F 

0061 coin 

0062 01 4C28006C 
0064 01 C4800029 
0066 01 4C100071 

0068 F0F4 

0069 01 D4800029 



MDX 
MDX 

ft 

ERR LD 

HFFFF STO 

ft 

FINER LD 
STO 

ft 

LD 
BSC 
LD 
BSC 

BCK1 EOR 
STO 



KSTRT-K-1 
-3 SET VALUE OF K 
HFFFF&l SUBTRACT CONSTANT OF ONE 
KSTRT SAVE IN KSTRT 

KLOW-K-JSPAN 
ONE+1 GET VALUE OF K 
SRCHT+1 SUBTRACT JSPAN 
KLOW SAVE IN KLOW 
-2 SET KLAST VALUE 
TMP SAVE IT 

CALCULATE THE ADDRESS OF THE 

SIGN OF THE QUOTIENT 
KCRD1 GET KCARD ADDRESS 
TMP SUBTRACT KLAST VALUE 
SRCHT+1 ADD JSPAN 
ONE+l ADD CONSTANT OF ONE 
OUOT+l STORE AODR OF SIGN OF OUOTIENT 

IS KLAST-KSTRT-JSPAN NEGATIVE 
TMP LOAD KLAST VALUE 
KSTRT SUBTRACT KSTRT 
SRCHT+1 SUBTRACT JSPAN 
ERR.+Z IF NEGATIVE-GO TO ERROR 

IS KLOW POSITIVE 
KLOW OK-GET KLOW VALUE 
ERRi+ IF NOT POSITIVE-GO TO ERROR 

FILL THE EXTENSION OF KCARD WITH 

ZEROES 
FILL OK-FILL EXTENSION WITH ZEROES 
•-• ADDRESS OF KCARD 
KLOW ADDRESS OF LEFT END OF EXTENSION 
KSTRT ADDRESS OF RGHT END OF EXTENSON 
ZIP ADDRESS OF CONSTANT OF ZERO 

JFRST-J 
»-• LOAD IR2 WITH JCARD COUNT 
»-« PICKUP JCARDIJFRST) 

IS JCARDIJFRST! POSITIVE 

■Z IF POSITIVE-GO TO HIT 

SEE IF JFRST IS LESS THAN JLAST. 

IF YESi JFRST-JFRST+1 AND GO 

BACK FOR MORE. IF NOi ERROR. 
-1 DECREMENT IR2 
SRCH GO BACK FOR MORE 

ERROR - NER-KLAST 

PICKUP KLAST VALUE 

AND STORE IN NER 

REPLACE JCARD SIGN 

PICKUP JCARD SIGN AND 
SGNJ+1 PUT IT BACK 

REPLACE KCARD SIGN 
KSIGN PICKUP KCARD SIGN 
KNESi+Z IF NESATIVE-GO TO KNEG 
SGNK+1 NOT NEGATIVE-PICKUP NEW SIGN 
SAVEli- IF NOT NEGATIVE-GO TO EXIT 
HFFFF+1 NEGATIVE-CHANGE SIGN AND 
SGNK+1 PUT INTO KCARD(KLAST) 



HIT.- 



TMP 

-1 



DIV 
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CSP06330 
CSP06340 
CSP06390 
CSP06360 
CSP06370 
CSP06380 
CSP06390 
CSP06400 
CSP06410 
CSP06420 
CSP06430 
CSP06440 
CSP06450 
CSP06460 
CSP06470 
CSP06480 
CSP06490 
CSP06300 
CSP06S10 
CSP06320 
CSP06330 
CSP06940 
CSP06S80 
CSP06960 
CSP06370 
CSP06980 
CSP06390 
CSP06600 
CSP06610 
CSP06620 
CSP06630 
CSP06640 
CSP06690 
CSP06660 
CSP06670 
CSP06680 
CSP06690 
CSP06700 
CSP06710 
CSP06720 
CSP06730 
CSP06740 
CSP06750 
CSP06760 
CSP06770 
CSP06780 
CSP06790 
CSP06600 
CSP06810 
CSP06820 
CSP06S30 
CSP06840 
CSP06890 
CSP06860 
CSP06870 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



006B 7005 
006C 01 C4800029 
006E 01 4C280071 
00 70 TOFT 



00T1 
0073 
0075 
0077 
0079 
007A 
0078 
007C 
007D 

007E 
007F 



00 65000000 
00 66000000 
00 67000000 
00 4C000000 
0000 
0000 
0000 
0000 
0000 

000* 
0000 



ooeo o 0003 



0081 
0082 
0083 
0084 
0085 
0086 
0087 



0088 

0089 
008A 
008B 

ooec o 

0080 
008E 
008F 

0090 

0091 

0092 

0093 
009* 

0095 

0096 

0097 



6A28 
COCC 
003E 
90F8 
9024 
90B6 
D04E 

C0F6 
9020 
9002 
D0CA 
90EC 
D00B 
C033 
90EF 
8019 
D009 
D038 
0039 
80C8 
D009 
D01A 
001B 



009A 00 C5000000 
009C A0E1 
0090 1090 
009E 00 85000000 
00A0 1890 
00A1 O A8B2 
00A2 D0DA 



MDX 
KNEG LO 
BSC 
MDX 
# 

SAVE1 LDX 
SAVE2 LOX 
SAVE3 LDX 
D0NE1 BSC 
KSTRT DC 
KSIGN DC 
QSIGN DC 
ZIP DC 
KLOW DC 



TEN 
TMP 



M 

SLT 

A 

SRT 

D 

STO 



DC 
DC 

STO 

STX 

LD 

STO 

S 

s 
s 

STO 

LD 
S 

s 

STO 

s 

STO 

LD 

S 

A 

STO 

STO 

STO 

A 

STO 

STO 

STO 



10 



0098 00 65000000 LOOPM LDX LI 



0IV1 LD LI »-« 



SAVE1 SO TO EXIT 
SGNK+1 NEGATIVE-PICKUP NEW SIGN 
SAVE1.+Z IF NEGATIVE-GO TO EXIT 
BCK1 NOT NEGATIVE-GO TO BCK1 

EXIT.. 

»-« RESTORE IR1 

«-» RESTORE IR2 

•-» RESTORE IR3 

«-» RETURN TO CALLING PROGRAM 

«-• ONE LESS THAN K 

•-« SIGN OF KCARD 

*-« SIGN OF QUOTIENT 

CONSTANT OF ZERO 

»-* SUBSCRIPT OF LEFTMOST POSITION 

OF EXTENSION OF KCARD 

CONSTANT OF TEN 
«-• TEMPORARY STORAGE 

JHIGH-JCARD(JFRST) 
SRCHT+1 SAVE FIRST SIGNIFICANT DIGIT 

KPUT-KLOW+JLAST-JFRST 
JLOOP+1 GET THE VALUE OF JLAST-JFRST 
KCRD1 GET KCARD ADDRESS 
KCRDZ SAVE FOR CARRY 
KLOW SUBTRACT KLOW VALUE 
JLOOP+1 SUBTRACT JLAST-JFRST VALUE 
MTWO+1 ADO CONSTANT OF TWO 
PUT2+1 SAVE ADDRESS FOR STORING 

KSTOP-KLAST+JFRST-JLAST-1 
TMP GET KLAST VALUE 
JLOOP+1 SUBTRACT JLAST-JFRST VALUE 
HFFFF+1 ADD CONSTANT OF ONE 
SRCH61 SAVE VALUE FOR COMPLIMENTING 
KSTRT SUBTRACT KSTRT VALUE 
LOOPM+1 SAVE COUNT AT LOOPM+1 
KCRDZ GET KCARD ADDRESS 
TMP SUBTRACT KLAST VALUE 
JL00P61 ADD JLAST-JFRST VALUE 
DIV161 SAVE FOR MULT. BY TEN 
DIV561 SAVE FOR ADD OF 10OKN0W 
DIV661 SAVE FOR STORE OF 10«KNOW 
HFFFF+1 SUBTRACT CONSTANT OF ONE 
DIV261 SAVE FOR ADD INTO MULT 
DIV361 SAVE FOR SUBTRACTION FROM 
D1V4S1 SAVE FOR STORE SUBTRACTED FROM 

KM'KSTRT 
«-« LOAD IR1 WITH COUNT 

MULT' ( 1 0»KCARO (KM I +KCARD I KM+ 1 ) ) 
DIVIDED BY JHIGH 

PICKUP KCARDIKM) 

MULTIPLY BY TEN 

REPOSITION PRODUCT 

ADO IN KCARD (KM* II 

REPOSITION FOR DIVISION 
SRCHT+1 OIVIDE BY JHIGH 
KLOW SAVE IN KLOW (MULT I 



TEN 
16 



16 
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CSP06880 
CSP06890 
CSP06900 
CSP06910 
CSP 06920 
CSP06930 
CSP06940 
CSP06950 
CSP06960 
CSP06970 
CSP06980 
CSP0699O 
CSP07000 
CSP0701O 
CSP07020 
CSP07030 
CSP07040 
CSP0705O 
CSP07060 
CSP07070 
CSP07080 
CSP07090 
CSP0710O 
CSP07110 
CSP07120 
CSP07130 
CSP07140 
CSP07150 
CSP07160 
CSP07170 
CSP07U0 
CSP07190 
CSP0720O 
CSP07210 
CSP0722O 
CSP07230 
CSP07240 
CSP07250 
CSP07260 
CSP07270 
CSP072SO 
CSP07290 
CSP07300 
CSP07310 
CSP07320 
CSP0733O 
CSP07340 
CSP07350 
CSP07360 
CSP07370 
CSP07380 
CSP07390 
CSP07400 
CSP07410 
CSP07420 
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00A3 0009 
00A4 01 4CO800D4 



00A6 6901 
00A7 00 67000000 



00A9 00 66000000 
00AS 1B10 



OOAC 00 96000000 
OOAE AOCE 
OOAF 1090 
OOBO 00 87000000 
00B2 00 D7000000 

00B4 73FF 
00B5 7000 



00B6 
00B7 
OOBB 
00 B9 
OOBA 
OOBB 
OOBC 
OOBD 
OOBE 
OOBF 



72FF 
70F3 
69EF 
C09C 
90ED 
DOEC 
6UDC 
C09B 
90DA 
D0D9 



OOCO 30 03059669 

00C2 0000 

00C3 1 OOAB 

00C4 1 0099 

00C9 1 OOAS 

00C6 01 4C1000D4 

oocs o aob; 

00C9 1090 

OOCA 00 89000000 

OOCC 00 05000000 



OOCE 
OOCF 

00 DO 
00D1 
0002 
00D3 



COSE 
OOAO 

C0A8 
8088 
D0A6 
7002 



000* C0A4 
00D9 00 04000000 



0007 01 74FF0006 



ADBCK STX 
KNOW LDX 



JLOOP LOX 
SRA 



MULT1 S 

M 

SLT 
DIV3 A 
DIV4 STO 

* 

MDX 

HDX 



MOX 

MOX 
STX 
LO 

s 

STO 

STX 

LD 

S 

STO 

CALL 
KCRD2 OC 
OC 
OC 
OC 

BSC 



L2 *-• 



L3 »-• 
L3 •-* 



3 -1 



2 -1 



01V5 
01V6 



M 

SLT 
A 
STO 

LD 
STO 

LD 
A 

STO 
MDX 



NQUO-MULT 
KSTRT SAVE IN KSTRT1N0U0I 

IS MULT GREATER THAN ZERO 
L PUT.+ IF MULT NOT POSITIVE-GO TO PUT 

KNOW-KM+1 
1 KNOW+1 POSITIVE-GET KM+1 AND 
L3 »-« PUT IT IN IR3 

JNOW-JFRST 
L2 »-« RELOAD IR2 WITH REMAINING JCARD 
16 CLEAR ACCUMULATOR 

KCARDIKNOWI-KCARDIKNOW) 

MULT«JCARD(JNOWI 

LOAD NEGATIVE JCARD (JNOWI 
KLOw MULTIPLY BY MULT 
16 REPOSITION PRODUCT 

ADD IN KCARDIKNOWI 

STORE AT KCARD(KNOW) 

KNOW-KNOW+1 

DECREMENT IR3 

NOP 

IS JNOW LESS THAN JLAST. IF YES 

JNOW-JNOW+1 AND GO BACK FOR MORE 

IF NO i RESOLVE CARRIES. 

DECREMENT IR2 
JLOOP+2 NOT DONE-GO BACK FOR MORE 
1 KNOW+1 OONE-CALCULATE 
SRCH&l THE VALUE OF 
KNOW+1 KNOW-1 

KNOW+1 BY COMPLIMENTING COUNT 
3 LOOPM+1 CALCULATE THE 
SRCHU VALUE OF KM 
LOOPM+1 BY COMPLIMENTING THE 
LOOPM+1 OTHER COUNT 

RESOLVE CARRIES IN THIS RESULT 
CARRY RESOLVE CARRIES 
«-» ADDRESS OF KCARD 
KNOW+1 ADDRESS OF KM 
LOOPM+1 ADDRESS OF KNOW-1 
KNOW+1 ADDRESS OF GENERATED CARRY 

IS KNOW LESS THAN ZERO 
L PUT.- IF NOT NEGATIVE-SO TO PUT 

KCARD(KM)«KCARDIKMI+10»KNOW 
TEN NEGATIVE-MULTIPLY CARRY BY TEN 
16 REPOSITION PRODUCT 
LI »-* ADD IN KCARDIKNOW) 
LI »-» STORE AT KCARDIKNOW) 

MULT— 1 
HFFFF+1 LOAD A MINUS ONE 
KLOW STORE IN MULT 

NQU0»NQU0-1 
KSTRT LOAD THE VALUE OF NOUO 
HFFFF+i SUBTRACT CONSTANT OF ONE 
KSTRT STORE IN NOUO 
ADBCK GO TO ADD OVERDRAW BACK 

KCAROIKPUTI-NQUO 



PUT 
PUT2 



LD 
STO 



00 D9 


71FF 




MDX 




OOOA 


70BF 




MDX 




OODB 


C09F 




LD 




OODC 01 


4C2S00E8 




BSC 


L 


OODE 00 


C4OO0000 


OUOT 


LD 


L 


OOEO 01 


4C10005E 




BSC 


L 


00E2 01 


F400005D 


BCK2 


EOR 


L 


00E4 01 


D48000DF 




STO 


I 


00E6 01 


4C00005E 




BSC 


L 


00E8 01 


C48000DF 


NES 


LD 


I 


OOEA 01 


4C28005E 




SSC 


L 


OOEC 


70F5 




MDX 




OOEE 






END 
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CSP07430 
CSP07440 
CSP07450 
CSP07460 
C5P07470 
CSP07480 
CSP07490 
CSP07500 
CSP07910 
CSP07S20 
CSP07530 
CSP07540 
CSP07990 
CSP07960 
CSP07570 
CSP07980 
CSP07990 
CSP07600 
CSP07610 
C5P07620 
CSP07630 
CSP07640 
CSP07690 
CSP07660 
CSP07670 
CSP07680 
CSP07690 
CSP07700 
CSP07710 
CSP07720 
CSP07730 
CSP07740 
CSP07790 
CSP07760 
CSP07770 
CSP077BO 
CSP07790 
CSP07800 
CSP07B10 
CSP07S20 
CSP07830 
CSP07840 
CSP07850 
CSP07860 
CSP07870 
CSP07880 
CSP07890 
CSP07900 
CSP07910 
CSP07920 
CSP07930 
CSP07940 
CSP07950 
CSP07960 
CSP07970 



KSTRT LOAD NQUO 

«-» STORE AT KCARD (KPUTI 

KPUT-KPUT+1 
PUT2+1.-1 MODIFY KCAROUPUTI ADDRESS 

SEE IF KM IS LESS THAN KSTOP. 

IF YES. KM-KM+1 AND GO BACK FOR 

MORE. IF NO. PLACE ALL SIGNS. 
-1 DECREMENT IR1 
DIV1 NOT DONE-GO BACK FOR MORE 

PUT SIGN ON QUOTIENT 
OSIGN DONE-PICKUP SIGN OF OUOTIENT 
NEG.+Z IF NEGATIVE-GO TO NEG 
»-« NOT NEGATIVE-PICKUP ACTUAL SIGN 
FINER.- IF NOT NEGATIVE-GO TO OTHERS 
HFFFF+1 NEGATIVE-CHANGE SIGN 
OUOT+1 PUT SIGN ON QUOTIENT 
FINER. GO TO REPLACE OTHER SIGNS 
QUOT+1 NEGATIVE-PICKUP ACTUAL SIGN 
FINER. +Z IF NEGATIVE-GO TO OTHER SIGN 
8CK2 GO TO CHANGE SIGN 
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CSP07980 
CSP0799O 
CSP08000 

cspoaoio 

CSP08020 
CSP08030 
CSP08040 
CSP08050 
CSP08060 
CSP08070 
CSP0S080 
CSP08090 
CSP08100 
CSP08110 
CSP0S120 
CSP0S130 
CSP08140 
CSP08190 
CSP08160 
CSP08170 
CSP08180 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICO MP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
334B OOOF 



WS UA DIV 



CSP08190 
CSP08200 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 

•• DPACK/DUNPK SUBROUTINES FOR 

• NAME DUNPK 

« LIST 

0000 049135D2 ENT 



1130 COMMERCIAL SUBROUTINE PACKAGE 



I 10) 
HO) 



0000 





0000 


DUNPK 


DC 




0001 





C003 




LD 




0002 





0020 




STO 




0003 





7007 




MDX 




0004 





7027 


SKI 


MDX 


X 


0009 





7000 


SW2 


MDX 


X 


0006 





oooo 


DPACK 


DC 




0007 





COFE 




LD 




0008 





00F7 




STO 




0009 





COFA 




LD 




000A 





Doie 




STO 




O00B 





6952 


START 


STX 


1 


oooc 





6A53 




STX 


2 


0000 


01 


65SO0O00 




LDX 


11 


000F 





C100 




LD 


1 


0010 





eooi 




A 




0011 


00 


95S00O01 


ONE 


S 


11 


0013 





DOOD 




STO 




0014 





C103 




LD 


1 


0015 





80FC 




A 




0016 


00 


95800004 


FOUR 


S 


11 


0018 





0006 




STO 




0019 





C100 




LD 


1 


001A 





80F7 




A 




001B 


00 


95800002 




S 


11 


0010 





DOES 




STO 




001E 


00 


65000000 


KCARD 


LDX 


LI 


0020 


00 


C400OOO0 


JCARD 


LD 


L 


0022 





6204 




LDX 


2 


0023 





7000 


SWTCH 


MDX 


X 


0024 





1890 




SRT 




0025 





COFB 




LD 




0026 





900F 




S 




0027 


01 


4C080059 




BSC 


L 


0029 





1810 


ASA IN 


SRA 




002A 





1084 




SLT 




002B 





FOOA 




EOR 




002C 


01 


4C180031 




BSC 


L 


002E 





F007 




EOR 




002F 





D100 




STO 


1 


0030 





71FF 




MDX 


1 


0031 





72FF 


NEXT 


MDX 


2 



0032 70F6 

0033 01 74FF0021 



0035 
0036 
0037 
0039 
003A 
003B 
003C 
003E 
00 3F 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0048 
0049 
004B 
004C 
004D 

004F 
0050 
0051 
0053 
0034 
0055 
0056 
0057 
0058 
0059 
005A 
005B 
0050 
005F 
0061 
0063 
0064 



70EA 

OOOF 

01 74010021 
6AE5 

C0E4 

90DB 

01 4C180046 
1884 

C023 
18DC 
72FF 
70FC 
1090 
D100 

71FF 

01 C4300021 

7011 

01 C4S00021 
100C 

1SDC 

01 74FF0021 

C0D1 

9035 

01 4C2B0037 
72FF 

70F4 
1090 
D100 
71FF 
70C7 
1090 

D100 

01 74050000 
00 65000000 

00 66000000 

01 4C800000 
FOOO 



DUNPK DUNPK SUBROUTINE ENTRY POINT 
CALL DUNPK IJCARD.J.JLAST.KCARD.KI 
THE WORDS JCARD IJ I THROUGH 
JCARD(JLAST) IN D4 FORMAT ARE 
UNPACKED INTO KCARD IN Dl FORMAT. 
DPACK DPACK SUBROUTINE ENTRT POINT 
CALL DPACK ( JCARD> J.JLAST.KCARD.K I 
THE WORDS JCARD IJ I THROUGH 
JCARDIJLAST) IN Dl FORMAT ARE PACKED 
INTO KCARD IN 04 FORMAT. 
«-« ARGUMENT ADDRESS COMES IN HERE 
SW2 LOAD NOP INSTRUCTION 
SWTCH STORE NOP AT SWITCH 
START COMPUTING 
ELSE-SWTCH-1 BRANCH TO ELSE 
NOP INSTRUCTION 
«-» ARGUMENT ADDRESS COMES IN HERE 
DPACK PICK UP ARGUMENT ADDRESS 
DUNPK AND STORE IT IN DUNPK 
SW1 LOAD BRANCH TO ELSE 
SWTCH STORE BRANCH AT SWITCH 
SAVE1+1 SAVE IR1 
SAVE2+1 SAVE IR2 
II DUNPK PUT ARGUMENT ADORESS IN IR1 

GET JCARD ADDRESS 
ONE+l ADD CONSTANT OF 1 

1 SUBTRACT J VALUE 
JCARO+1 CREATE JCARO(J) ADDRESS 

3 SET KCARD ADDRESS 
ONE+l ADD CONSTANT OF 1 

4 SUBTRACT K VALUE 
KCARD+1 CREATE KCARDIK) ADDRESS 
GET JCARD AODRESS 
ONE+l ADD CONSTANT OF 1 

2 SUBTRACT JLAST VALUE 
OPACK CREATE JCARDIJLAST) ADDRESS 
•-• PUT KCARO ADORESS IN IR1 
♦-• PICK UP JCARDtJI 
4 LOAD IR2 WITH 4. DIGITS/WORD 
SWITCH BETWEEN DPACK AND DUNPK 
16 TEMPORARILY SAVE ACCUM IN EXTNTN 

CHECK FOR JCARDIJLAST) 
JCARD+1 PICK UP CURRENT JCARD ADDR 
DPACK SUBTRACT JCARDIJLAST) 
ALLD0.+ IF ZERO. ALL DONE - ALLDO 
16 NOT DONE - CLEAR ACCUMULATOR 
4 GET FIRST DIGIT OF WORD 
HOOOF IS IT FILLER 
NEXT.+- YES - GO TO NEXT 
HOOOF NO - RESTORE TO ORIGINAL 
STORE IN KCARD 
-1 GO TO NEXT WORD OF KCARD 
-1 DECREMENT DIGIT5/WOR0 



CSP08210 
CSP0S220 
CSP08230 
CSP0B240 
CSP0B250 
CSP08260 
CSP08270 
CSP0B280 
CSP0S290 
CSP08300 
CSP08310 
CSP08320 
CSP08330 
CSP08340 
CSP06350 
CSP0B360 
CSP0837O 
CSP08380 
CSP0S390 
CSP08400 
CSP08410 
CSP08420 
CSP0S430 
CSP08440 
CSP08450 
CSP08460 
CSP08470 
CSP084S0 
CSP08490 
CSP08500 
CSP08910 
CSP08520 
CSP08930 
CSP08940 
CSP0B550 
CSP06560 
CSP08S70 
CSP08580 
CSP08590 
CSP08600 
CSP0861O 
CSP08620 
CSP08630 
CSP08640 
CSP08690 
CSP0B660 
CSP08670 
CSP08680 
CSP08690 
CSP08700 
CSP08710 
CSP08720 
CSP08730 
C5P08740 
CSP08750 
CSP08760 
C5P08770 



MDX AGAIN MORE IN THIS WORD - GO BACK 

MDX L JCARD+1. -1 THIS WORD DONE 

• GET NEXT WORD IN JCARD 
MDX JCARD GO BACK 

HOOOF DC /OOOF CONSTANT OF 13 TO DETECT FILLER 

EN MDX L JCARD+1. 1 BACK UP JCARD FOR SIGN 

STX 2 KCARD+1 IF DIGITS/WORD IS FOUR. 

LD KCARD+1 ALL DONE EXCEPT FOR SIGN 

S FOUR+1 SUBTRACT FOUR FROM DIGITS/WORD 

BSC L LAST.*- IF ZERO - ALL DONE - GO LAST 

SRT 4 NOT DONE - TAKE OUT SIGN 

BACK LD HF000 PUT IN FILLER 

RTE 28 SET FILLER IN LOW ORDER OF EXTN 

MDX 2 -1 DECREMENT DIGITS/WORD 

MDX BACK MORE - GO BACK 

5LT 16 DONE - PUT EXTENSION IN ACCUM 

STO 1 STORE IN KCARO 

MDX 1 -1 GET NEXT WORD OF KCARD FOR SIGN 

LAST LD I JCARD+1 PICK UP SIGN OF JCARD 

MDX ALLDO+1 GO TO INSTRUCTION AFTER ALLDO 

OVR LD I JCARD+1 PICK UP NEXT JCARD DIGIT 

ELSE SLA 12 PUT DIGIT IN HIGH ORDER OF ACC 

RTE 28 SET 01GIT IN LOW OROER OF EXTN 

MDX L JCARD+1 .-1 GET NEXT JCARD WORD 

• CHECK FOR JCARDIJLAST) 
LD JCARD+1 PICK UP CURRENT JCARD ADDR 
S DPACK SUBTRACT JCARDIJLAST) 
BSC L EN.+Z IF ZERO. ALL DONE • GO TO EN 
MDX 2 -1 NOT OONE-OECREMENT DIGITS/WORD 
MDX OVR GO BACK FOR NEXT DIGIT 
SLT 16 WORD FULL-PUT EXTN IN ACCUM 
STO 1 STORE IN KCARD 
MDX 1 -1 GET NEXT KCARD WORO 
MDX JCARD GO BACK 

ALLDO SLT 16 DONE-PUT EXTENSION IN ACCUMULTR 

STO 1 STORE SIGN IN KCARD 

MDX L DUNPK. 5 CREATE RETURN AODRESS 

SAVE1 LDX LI «-« RESTORE IR1 

SAVE2 LDX L2 •-» RESTORE IR2 

BSC I DUNPK RETURN TO CALLING PROGRAM 

HF000 DC /FOOO CONSTANT OF 15 FOR FILLER 

END 



PAGE 2 

CSP08780 
CSP08790 
CSP08S00 
CSP0S810 
CSP08820 
CSP0S830 
CSP08840 
CSP0885O 
CSP08860 
CSP0887O 

csposeeo 

CSP08890 
CSP0890O 
CSP08910 
CSP08920 
CSP08930 
CSP08940 
CSP08950 
CSP08960 
CSP0897O 
CSP06980 
CSP08990 
CSP09000 
CSP09010 
CSP09020 
CSP09030 
CSP09040 
CSP0905O 
CSP09060 
CSP09070 
CSP09080 
CSP09090 
CSP09100 
CSP09110 
CSPO9120 
CSP09130 
CSP09140 
CSP09150 
CSP09160 
CSP09170 
CSP09180 
CSP09190 



NO ERRORS IN ABOVE ASSEMBLY. 
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// DUP 
♦STORE 
339A 0007 



WS UA DUNPK 



CSP09200 
CSP09210 



// ASM 

»» EDIT SUBROUTINE 

» NAME EDIT 

* LIST 

0000 05109SCO 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(IDI 
(101 



0000 





0000 


EDIT 


DC 




0001 





6960 




STX 


1 


0002 





6A6E 




STX 


2 


0003 


01 


69600000 




LDX 


11 


0005 





C100 




LO 


1 


0006 





D02B 




STO 




0007 





007C 




STO 




0008 


00 


95800002 




S 


11 


00 OA 





8007 




A 




000D 





0050 




STO 




00 OC 





C102 


TWO 


LD 


1 


0000 





D025 




STO 




OOOE 





D076 




STO 




OOOF 


00 


C5800002 




LD 


11 


0011 


00 


95800001 


ONE 


S 


11 


0013 





80FE 




A 




0014 





4808 




BSC 




001S 





COFC 




LD 




0016 





0026 




STO 




0017 





C104 




LD 


1 


0018 





0076 




STO 




0019 


01 


D40OO0CO 




STO 


L 


001B 





C10S 




LD 


1 


001C 





D073 




STO 




001D 





C103 




LD 


1 


001E 





D06F 




STO 




001F 


01 


D40000BF 




STO 


L 


0021 


00 


95800005 




S 


11 


0023 





SOEE 




A 




0024 





001A 




STO 




0023 





D07E 




STO 




0026 


00 


C5800003 




LD 


11 


0028 


00 


95800004 


FOUR 


S 


11 


002A 


a 


80E7 




A 




0026 





4808 




BSC 




002C 





C0E5 




LD 




002D 


a 


DOOD 




STO 




002E 





7106 




MDX 


1 


002F 





6943 




STX 


1 


0030 


30 


19A56549 




CALL 




0032 





0000 


JCR01 


DC 




0033 





0000 


JLAS1 


DC 




0034 


l 


0029 




DC 




0035 


l 


00C9 




DC 





EDIT EDIT SUBROUTINE ENTRY POINT 
CALL EDITIJCARD>JtJLAST>KCARD»K.KLASTI 
THE WORDS JCARD(JI THROUGH 
JCARD(JLAST) ARE EDITED UNOER 
CONTROL OF THE MASK AT WOROS 
KCARDIKI THROUGH KCARDIKLAST) 
AND THE RESULT IS AT KCARDIKI 
THROUGH KCARDIKLAST). 

*-* ARGUMENT ADDRESS COMES IN HERE 

SAVEl+l SAVE IR1 

SAVE2+1 SAVE IR2 

EDIT PUT ARGUMENT ADDRESS IN IR1 

GET JCARO ADDRESS 
JCRD1 SAVE JCARD ADDRESS FOR NZONE 
JCR02 SAVE JCARD ADDRESS FOR NZONE 
2 SUBTRACT JLAST VALUE 
ONE+1 ADD CONSTANT OF ONE 
JCARD+1 CREATE JCARDIJLAST) ADDRESS 
2 GET JLAST ADDRESS 
JLAS1 SAVE JLAST ADDRESS FOR NZONE 
JLAS2 SAVE JLAST ADDRESS FOR NZONE 

2 GET JLAST VALUE 

1 SUBTRACT J VALUE 
ONE+1 ADD CONSTANT OF ONE 
+ CHECK FIELD WIDTH 
ONE+1 NEGATIVE OR ZERO-MAKE IT ONE 
LDXJ+1 SAVE FIELD WIDTH 

4 GET K ADDRESS 
Kl SAVE K ADDRESS FOR FILL 
K2 SAVE K ADDRESS FOR FILL 

5 GET KLAST ADDRESS 
KLAS1 SAVE KLAST ADDRESS FOR FILL 

3 GET KCARD ADDRESS 
KCRD1 SAVE KCARD ADDRESS FOR FILL 
KCR02 SAVE KCARD ADDRESS FOR FILL 

5 SUBTRACT KLAST VALUE 
ONE+1 ADD CONSTANT OF ONE 
KCARD+1 CREATE KCARDIKLAST! ADDRESS 
KCRD3+1 CREATE KCARDIKLAST! ADDRESS 
9 GET JLAST VALUE 

4 SUBTRACT J VALUE 
ONE+1 ADD CONSTANT OF ONE 
+ CHECK FIELD WIDTH 
ONE+1 NEGATIVE OR ZERO-MAKE IT ONE 
LDXK+1 SAVE FIELD WIDTH 

6 MOVE OVER SIX ARGUMENTS 
D0NE1+1 CREATE RETURN ADDRESS 

REMOVE AND SAVE THE JCARO ZONE 
NZONE NZONE TO REMOVE SIGN 
*-» ADDRESS OF JCARO 
*-• ADDRESS OF JLAST 
FOUR+1 ADORESS OF A FOUR 
NSIGN ADDRESS OF OLD SIGN INDICATOR 



CSP09220 
CSP09230 
CSP09240 
CSP09250 
CSP09260 
CSP09270 
CSP09260 
CSP09290 
CSP09300 
CSP09310 
CSP09320 
CSP09330 
CSP09340 
CSP09350 
CSP09360 
CSP09370 
CSP09380 
CSP09390 
CSP09400 
CSP09410 
CSP09420 
CSP09430 
CSP09440 
CSP09450 
CSP09460 
CSP09470 
CSP09480 
CSP09490 
CSP09500 
CSP09510 
CSP09920 
CSP09530 
CSP09940 
CSP09590 
CSP09560 
CSP09570 
CSP09580 
CSP09390 
CSP09600 
CSP09610 
CSP09620 
CSP09630 
CSP09640 
CSP09650 
CSP09660 
CSP09670 
CSP09680 
CSP09690 
CSP09700 
CSP09710 
CSP09720 
CSP09730 
CSP09T40 
CSP09750 
CSP09760 
CSP09770 
CSP09780 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



0036 
0037 







C85C 
065C 




LDD 

STO 




0038 
0039 






1810 
D05D 




SRA 
STO 




003A 


00 


65000000 


LDXK 


LDX 


l: 


003C 


00 


66000000 


L0XJ 


LDX 


l; 


003E 
0040 


00 



C4000000 
D0FA 


KCAR0 


LD 
STO 


l 


0041 


01 


4C100047 




BSC 


L 


00*3 
0044 
0046 




01 




9052 

4C20007E 
700F 




S 

BSC 

MDX 


L 


0047 
0048 
004A 




01 




904B 

4C180057 

C0F0 


POSZ 


S 

esc 

LB 


L 


004B 

OO'.C 
004E 




01 




9040 

4C180054 

COEC 




s 

BSC 
LD 


L 


004F 
0050 
0051 








9048 
4820 
702C 




S 

BSC 

MDX 




0052 
0053 






COES 
D041 




LD 
STO 




0054 
0055 






C0E6 
&03E 


MNY 


LD 
STO 




0056 





6940 


ZRSP 

* 


STX 




0057 
0056 
0059 




01 


6AA8 

C0A7 
4COS007E 


SRCE 

» 


STX 

LD 

BSC 


L 


005B 
0050 
003F 


00 
01 




C4000000 
D480003F 
D00D 


# 
JCARD 


LD 

STO 

STO 


L 
I 


0060 
0061 
0062 




01 


72FF 
7000 
740100SC 




MDX 
MDX 
MDX 


L 



NDUMP-16448 

M0NEY-1644B 
BLANK LOAD TWO BLANKS 
MONET STORE IN MONEY AND NDUMP 

NZRSP'O 
16 CLEAR THE ACCUMULATOR 
NZRSP SET NZRSP EQUAL TO ZERO 

KNOW-KLAST 
*-• LOAD IR1 WITH KCARD COUNT 

JNOW«JLAST 
»-• LOAD IR2 WITH JCARD COUNT 

KTEST"KCAR0CKNOW> 
*-• PICKUP KCARD (KNOW) 
LDXK+1 AND SAVE IT TEMPORARILY 

IS KTEST NEOATIVE 
POSZ.- IS IT NEGATIVE-NO-GO TO POSZ 

IS KTEST EQUAL TO AN EBCDIC ZERO 
ZERO YES-CHECK AGAINST EBCDIC ZERO 
NEXT.Z IF NOT EOUAL-GO TO NEXT 
ZRSP IF EQUAL-GO TO ZRSP 

IS KTEST EQUAL TO 16448 
BLANK NOT NEGATIVE-CHECK AGAINST EBCD 
SRCE.+- BLANK-EOUAL-GO TO SRCE 
LDXK-.1 NOT EQUAL-PICKUP KTEST 

IS KTEST EQUAL TO 23616 
OLRSG IS IT A DOLLAR SIGN 
MNY.f- YES-GO TO MNY 
LDXK+1 NO-PICKUP KTEST 

IS KTEST EQUAL TO 23360 
AST IS IT AN ASTERISK 
Z YES-SKIP NEXT INSTRUCTION 
NEXT NO-GO TO NEXT 

NDUMP-KTEST 
LDXK*1 PICKUP KTEST AND 
NDUMP STORE IT IN NDUMP 

MONEY-KTEST 
LDXK+1 PICKUP KTEST AND 
MONEY STORE IT IN MONEY 

NZRSP-KNOW 
NZRSP SAVE KNOW IN NZRSP 

SEE IF JNOW IS LESS THAN J. IF 

YES. GO TO NEXT. IF NO. GO TO 

JCARD. 
EDIT GET IR1 AND 
EDIT LOAD ITS VALUE 
NEXT.+ IF NOT POSITIVE-GO TO NEXT 

KTEST-JCARDIJNOWI 

KCARDIKNOWI-KTEST 
«-• POSITIVE-PICKUP JCAROIJNOWI AND 
KCARD+1 STORE IT IN KCARDIKNOW) 
LDXJ-H STORE IN KTEST 

JNOW JNOW- 1 
-1 DECREMENT 1R2 
« NOP 
JCARD-U.l MODIFY JCARD ADDRESS TO 
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CSP09790 
CSP0980O 
CSP09810 
CSP09820 
CSP09830 
CSP09840 
CSP09S50 
CSP09860 
CSP09S70 
CSP09880 
CSP09S90 
CSP09900 
CSP09910 
CSP09920 
CSP09930 
CSP09940 
CSP09950 
CSP09960 
CSP09970 
CSP09980 
CSP09990 
CSP10000 
CSP10010 
CSP10020 
CSP10030 
CSP10040 
CSP10030 
CSP10060 
CSP10070 
CSP100B0 
CSP10090 
CSP10100 
CSP10110 
C5P10120 
CSP10130 
CSP10140 
CSP10150 
CSP1O160 
CSP10170 
CSP10180 
CSP10190 
CSP10200 
CSP10210 
CSP10220 
CSP1O230 
CSP10240 
CSP10250 
CSP10260 
CSP1027O 
CSP10280 
CSP10290 
CSP10300 
CSP10310 
CSP10320 
CSP10330 
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0064 C032 

0065 01 4C0B007E 

006T C005 
0068 01 4C100074 
006A 902B 
006B 01 4C1S007E 
006D 7000 

006E 00 65000000 
0070 00 66000000 
0072 00 4C00O000 

0074 901E 

0075 01 4C18007E 



0077 

0078 

0079 01 



C0C5 
9021 

4C18007E 



007B 691B 
007C 01 74FF0097 



007E 01 7401003F 



0080 

0081 



71FF 
70BC 



0082 30 15A56543 

0084 0000 

0085 0000 

0086 1 00C9 

0087 1 0000 



0088 6AA9 

0089 C0A8 
00SA 01 4C08009F 
008C 30 062334C0 



008E 





0000 


008F 





0000 


0090 





0000 


0091 


1 


0098 


0092 





70DB 


0093 





4040 


0094 





0000 


0093 





0000 


0096 





F040 



• JNOW-1 

• IS NZRSP POSITIVE 
LD NZRSP PICKUP NZRSP AND 
BSC L NEXT.+ IF N07 POSITIVE-GO 70 NEXT 

• IS KTEST NEGATIVE 
LD LDXJ+1 POSITIVE-PICKUP KTEST 
BSC L OVER.- IF NOT NEGATIVE-GO TO OVER 
S ZERO NEGATIVE-CHECK AOAINST ZERO 
BSC L NEXT.*- EQUAL-00 TO NEXT 
MDX SETAO NOT EQUAL-GO TO SETAG 

• EXIT 

SAVE1 LDX LI »-• RESTORE IR1 

SAVE2 LDX L2 «-« RESTORE IR2 

D0NE1 BSC L «-« RETURN TO CALLING PROGRAM 

• IS KTEST EQUAL TO BLANK 
OVER S BLANK CHECK KTEST AGAINST BLANK 

BSC L NEXT«+- IF EQUAL-GO TO NEXT 

» IS KTEST EQUAL TO COMMA 

LD LDXJ+1 NOT EQUAL-CHECK KTEST 

S COMMA AGAINST A COMMA 

BSC L NEXTI+- EQUAL-GO TO NEXT 

« NZRSP "KNOW-1 

SETAG STX 1 NZRSP NOT EQUAL-SET NZRSP EQUAL TO 

MDX L NZRSPi-1 KCARD COUNT MINUS ONE 

• KNOW.KNOW-1 

• SEE IF KNOW IS LESS THAN K.. IF 
» YES> PUT JCARD ZONE BACK. IF NO 

• GO BACK FOR MORE. 
NEXT MDX L KCARO+1.1 MODIFY KCARD ADDRESS TO 
« KNOW-1 

MDX 1 -1 DECREMENT IR1 

MDX KCARD GO BACK FOR MORE 

• PUT JCARD ZONE BACK 
CALL NZONE RESTORE JCARO ZONE 

JCRD2 DC *-• ADORESS OF JCARD 

JLAS2 OC «-* ADORESS OF JLAST 

DC NSIGN ADORESS OF NEW SIGN INDICATOR 

DC EDIT DUMMY 

• SEE IF JNOW IS LESS THAN J. IF 

• YES. GO TO OK. IF NO. FILL WITH 

• ASTERISKS AND EXIT 
STX 2 JCRD1 GET THE CONTENTS OF 
LD JCRD1 IR2 AND CHECK 
BSC L OK.+ IF NOT POSITIVE-GO TO OK 
CALL FILL POSITIVE-ERROR-JCARD TOO LONG 

» FILL KCARD WITH ASTERISKS 

KCRD1 DC »-» ADORESS OF KCARD 

Kl DC »-« ADORESS OF K 

KLAS1 DC »-» ADDRESS OF KLAST 

DC AST ADDRESS OF FILL CHARACTER 

MDX SAVE1 GO TO EXIT 

BLANK DC /404O CONSTANT OF EBCDIC BLANK 

MONEY DC «-« FILL FOR FLOATING S 

NDUMP DC •-» FILL FOR ANY SUPPRESSION 

ZERO DC /F040 CONSTANT OF EBCDIC ZERO 
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CSP10340 
CSP10330 
CSP1036O 
CSP10370 
CSP103S0 
CSP10390 
CSP10400 
CSP10410 
CSP1042O 
CSP10430 
CSP10440 
CSP10430 
CSP10460 
CSP10470 
CSP10480 
CSP10490 
CSP10300 
CSP10910 
CSP10920 
CSP10330 
CSP10940 
CSP10330 
CSP10560 
CSP10S70 
CSP10S80 
CSP10590 
CSP10600 

cspi06io 

CSP10620 
CSP10630 
CSP10640 
CSP106S0 
CSP10660 
CSP10670 
CSP10680 
CSP10690 
CSP10700 
CSP10710 
CSP10720 
CSP1O730 
CSP10740 
CSP10750 
CSP10760 
CSP10770 
CSP10780 
CSP10790 
CSP10800 
CSPIOSIO 
CSP10820 
CSP10830 
CSP10840 
CSP10850 
CSP10860 
CSP10870 
CSP1088O 



0097 0000 


NZRSP 


DC 


0098 3C40 


AST 


DC 


0099 5B40 


DLRSG 


DC 


009A 6B40 


COMMA 


DC 


009B 6040 


MINUS 


DC 


009C D940 


R 


DC 


0090 0001 


0NE2 


OC 


009E 0002 


TW02 


DC 


009F C029 


OK 


LD 


OOAO 90FD 




S 


00A1 01 4C1600B6 




BSC L 


00A3 00 C40O0O00 


KCRD3 


LO L 


00A5 90F3 




S 


00A6 01 4C1800B3 




BSC L 


00A8 80F2 




A 


00A9 90F2 




S 


OOAA 01 4C2000B6 




BSC L 


OOAC 01 740100A4 


* 


MDX L 


OOAE C0E4 


M 


LD 


OOAF 01 D48000A4 




STO I 


00B1 01 74FF00A4 


f 


MDX L 


00B3 CODF 


LD2 


LD 


00B4 01 D48000A4 




STO I 


00B6 COEO 


NEG 


LD 


O0B7 01 4C08006E 




BSC L 


00B9 01 S480008F 




A I 


OOBB 90E1 




S 


OOBC D0E7 




STO 


OOBD 30 062534C0 




CALL 


OOBF 0000 


KCRD2 


: DC 


OOCO 0000 


K2 


DC 


0OC1 1 00A4 




DC 


00C2 1 0095 




DC 


O0C3 COFB 




LD 


00C4 90DF 




S 


00C9 80D7 




A 


00C6 D002 




STO 


00C7 COCC 




LD 


OOCS 00 D40OO0OO 


STOK 


STO L 


00C9 


NSIGN EQU 


OOCA 70A3 




MDX 


OOCC 




END 



»-» HOW FAR TO ZERO SUPPRESS 
/3C40 CONSTANT OF ASTERISK 
/5B40 CONSTANT OF DOLLAR SIGN 
/6840 CONSTANT OF COMMA 
/6040 CONSTANT OF MINUS SIGN 
/D940 CONSTANT OF LETTER R 

1 CONSTANT OF ONE 

2 CONSTANT OF TWO 

IS NSIGN EQUAL TO TWO 
NSIGN PICKUP THE ORIGINAL ZONE 
TW02 INOICATOR AND CHECK AGAINST TWO 
NEG.t- EQUAL-GO TO NEG 

KTEST-KCARDIKLAST1 
•-• NOT EQUAL-PICKUP KCARO(KLAST) 
MINUS AND CHECK AGAINST MINUS SIGN 
L02.+- IF EQUAL-GO TO LD2 
MINUS NOT EQUAL-GET KTEST AND CHECK 
R AGAINST LETTER R 
NEG.Z IF NOT EQUAL-GO TO NEG 
KCRD3+1.1 EQUAL-GET ADDRESS OF 
KCARDIKLAST-lt 

KCARD<KLAST-1) "16448 
BLANK PICKUP A BLANK 
KCRDSn STORE AT KCARD (KLAST-1) 
KCRD3*1.-1 GET ADDR OF KCARD(KLAST) 

KCARDIKLASTI-16448 
BLANK PICKUP A BLANK 
KCRD3+1 STORE AT KCARDIKLAST) 

IS NZRSP GREATER THAN ZERO 
NZRSP GET NZRSP AND 
SAVE1.+ IF NOT POSITIVE-EXIT 
Kl POSITIVE-CALCULATE SUBSCRIPT OF 
ONE2 LAST POSITION TO BE ZERO 
KCRD3<1 SUPPRESSED-END OF FILL AREA 

ZERO SUPPRESS 
FILL FILL ROUTINE TO ZERO SUPPRESS 
*-* ADDRESS OF KCARD 
*-» ADDRESS OF K 

KCRD3+1 ADORESS OF END OF FILL AREA 
NOUMP ADDRESS OF FILL CHARACTER 

KCARD I NZRSP) -MONEY 
KCRD2 GET KCARO ADDRESS 
KCRD3+1 SUBTRACT LAST FILL VALUE 
0NE2 ADD CONSTANT OF ONE 
STOK+1 CREATE KCAROINZRSPI ADDRESS 
MONEY PICKUP MONEY VALUE 
•-» STORE FOR SUPPRESSION 
STOK+1 TO SAVE CORE STORAGE 
SAVE1 GO TO EXIT 
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CSP10S90 
CSP10900 
CSP10910 
CSP10920 
CSP10930 
CSP10940 
CSP10930 
CSP10960 
CSP10970 
CSP10980 
CSP10990 
CSP11000 
CSP11010 
CSP11020 
CSP1103O 
CSP11040 
CSP1103O 
CSP11060 
CSP11070 

cspnoeo 

CSP11090 
CSP11100 
CSP11110 
CSP11120 
CSP11130 
CSP11140 
CSP11150 
CSPU160 
CSP11170 
CSP1UB0 
CSP11190 
CSP11200 
CSP11210 
CSP11220 
CSP11230 
CSP11240 
CSP11230 
CSP11260 
CSPH270 
CSP11280 
CSPH290 
CSP11300 
CSP11310 
CSP11320 
CSP11330 
CSP11340 
CSP11350 
CSP11360 
CSPU370 
CSP11380 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// DUP 
•STORE 
3361 0000 



WS UA EDIT 



CSP11390 
CSP11400 



// ASM 

»* FILL SUBROUTINE 

• NAME FILL 

« LIST 

0000 O62934C0 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



110) 
IIDI 



0000 





ooco 


FILL 


DC 




#-« 


0001 





6919 




5TX 


1 


SAVE 


0002 


01 


65800000 




LDX 


11 


FILL 


0004 





C100 




LD 


1 





0009 


00 


95800002 




S 


11 


2 


0007 





DOOF 




STO 




STO+ 


ooos 


00 


C5800002 




LD 


11 


2 


000A 


00 


95800001 


ONE 


S 


11 


1 


oooc 





80FE 




A 




0NE+ 


0000 





4608 




BSC 




+ 


OOOE 





COFC 




LO 




0NE+ 


000F 





0009 




STO 




LDXf 


0010 


00 


C5800003 




LO 


11 


3 


0012 





7104 




MDX 


1 


4 


0013 





6909 




STX 


1 


DONE 


0014 


00 


65000000 


LDX 


LDX 


LI 


#-« 


0016 


00 


D5000000 


STO 


STO 


LI 


#-» 


0018 





71FF 


• 


MDX 


1 


-1 


0019 





70FC 




MDX 




STO 


00 1A 


00 


65000000 


SAVE1 


LDX 


LI 


»-• 


001C 


00 


4C000000 


DONE1 


BSC 


L 


• -• 


001E 








END 







FILL SUBROUTINE ENTRY POINT 

CALL FILLIJCARDtJtJLASTiNCH) 

THE WORDS JCARD(J) THROUSH 

JCARDIJLA5T) ARE FILLED WITH THE 

CHARACTER AT LOCATION NCH. 

ARGUMENT ADDRESS COMES IN HERE 
l+l SAVE IR1 

PUT ARGUMENT ADDRESS IN IR1 

GET JCARD ADDRESS 

SUBTRACT VALUE OF JLAST 
1 CREATE ADDRESS OF JCARDl JLAST) 

GET VALUE OF JLAST 

SUBTRACT VALUE OF J 
1 ADD CONSTANT OF ONE 

CHECK FIELD WIDTH 
1 NEGATIVE OR ZERO - MAKE IT ONE 
1 OK - STORE FIELD WIDTH IN LDX 

GET FILL CHARACTER - NCH 

MOVE OVER FOUR ARGUMENTS 
1+1 CREATE RETURN ADDRESS 

JNOW-J 

LOAO IR1 WITH FIELD WIDTH 

JCARD 1JNOW) «NCH 

STORE FILL CHAR AT JCARDIJNOWI 

SEE IF JNOW IS LESS THAN JLAST. 

IF YES. JNOW-JNOW+1 AND GO BACK 

FOR MORE. IF NO. EXIT. 

DECREMENT FIELD WIDTH 

NOT DONE - GO BACK FOR MORE 

EXIT.... 

DONE - RESTORE IR1 

RETURN TO CALLING PROGRAM 



NO ERRORS IN ABOVE ASSEMBLY. 



// OUP 
•STORE 
336E 0003 



WS UA FILL 



CSP11410 
CSP11420 
CSP11430 
CSP11440 
CSP11450 
CSP11460 
CSP11470 
CSP11480 
CSP11490 
CSP11900 
CSP11510 
CSP11520 
CSP11530 
CSP11540 
CSP11550 
CSP11960 
CSP11570 
CSP11990 
CSP11390 
CSP1U00 
CSP11610 
CSPU620 
CSP11630 
CSP11640 
CSP11650 
C5P11660 
CSP11670 
C5PU680 
CSPU690 
C5P11700 
CSP11710 
CSP11720 
CSP11730 
CSP11740 
CSP11750 
CSP11760 
CSP11770 



CSP11780 
CSP11790 
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// ASM 

•< GET SUBROUTINE 

• NAME SET 

* LIST 

0000 07163000 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 
( 10) 



0000 





oooo 


GET 


DC 




0001 





694B 




STX 


1 


0002 


01 


69600000 




LDX 


11 


000* 





C100 




LB 


1 


0009 





D013 




STO 




0006 





D03C 




STO 




0007 


00 


99800002 


TWO 


S 


11 


0009 





D01B 




STO 




OOOA 





C103 




LD 


1 


OOOB 





0033 




STO 




OOOC 


00 


C9800002 




LO 


11 


OOOE 





00F1 




STO 




OOOF 


00 


99800001 


ONE 


S 


11 


0011 





80FE 




A 




0012 





480B 




BSC 




0013 





COFC 




LO 




0014 





DOOE 




STO 




001S 





7104 




MDX 


1 


0016 





6938 


* 


STX 


1 


0017 


30 


19A56945 


# 


CALL 




0019 





0000 


JCRDl 


DC 




001A 


1 


0000 




DC 




00 IB 


1 


0050 




OC 




00 1C 


1 


0019 




DC 




001D 





18A0 




SRT 




001E 





0B7E 




STD 


3 


00 IF 





D37D 




STO 


3 


0020 


20 


0S8A3580 




LIBF 




0021 


1 


005A 




DC 




0022 


00 


65000000 


CNT 


LDX 


LI 


0024 


00 


C5000000 


JCRD2 


LD 


LI 


0026 


01 


4C2B002C 




BSC 


L 


0026 





9028 




S 




0029 


01 


4C200053 




BSC 


L 


0028 





C026 




LD 




002C 





9025 


MAVBE 


S 




0020 


01 


4C280053 


* 


BSC 


L 


002F 





1806 


ft 


SRA 




0030 


20 


064D6063 




LIBF 





0031 20 


058A3580 


LIBF 


0032 1 


0097 


DC 


0033 20 


094C4000 


LIBF 


0034 1 


005A 


DC 


0039 20 


09917A00 


LIBF 


0036 1 


009D 


DC 


0037 20 


19399500 


LIBF 


0038 20 


05044100 


LIBF 


0039 1 


0057 


DC 


003A 20 


03SA3980 


LIBF 


003B 1 


005A 


DC 



00 3C 
003D 



7 IFF 

70E6 



003E 20 09917A00 
00 3F 0000 

0040 20 19599900 

0041 30 15A56545 

0043 0000 

0044 1 0000 

0045 1 0019 

0046 1 0043 



0047 C0D1 

0048 90BF 

0049 01 4C20004C 

004B 20 22959000 



004C 00 
004E 00 

0090 

0091 

0052 

0053 

0054 

0055 

0056 
0057 
009A 
0090 84 
0060 



69000000 

4C000000 

0004 

4040 

F040 

10A0 

DB7E 

D37D 

70F5 

0003 

0003 

90000000 



FIN 

DON El 

FOUR 

BLANK 

ZERO 

ERR 



TEMP 

ANS 

ETEN 



GET GET SUBROUTINE ENTRY POINT 
GET (JCARD. J. JLAST. SHI FT) 
THE WORDS JCARO(J) THROUGH 
JCARD<JLAST( ARE CONVERTED TO A 
REAL NUMBER AND MULTIPLIED BY 
SHIFT TO PLACE THE DECIMAL POINT 

»-» ARGUMENT ADDRESS COMES IN HERE 

FIN+1 SAVE IR1 

GET PUT ARGUMENT ADDRESS IN IR1 

GET JCARD ADDRESS 

JCRDl STORE FOR NZONE AT JCRDl 
JCRD3 STORE FOR NZONE AT JCRD3 

2 SUBTRACT JLAST VALUE 
JCRD2+1 CREATE JCARO(JLAST) ADDRESS 

3 GET SHIFT ADDRESS AND 

SHIFT STORE FOR MULTIPLY TO PLACE ■ 
2 GET JLAST VALUE AND 
GET SAVE FOR NZONE 

1 SUBTRACT J VALUE 
ONE+1 ADD CONSTANT OF ONE 
+ CHECK FIELD WIDTH 

ONE+1 NEGATIVE OR ZERO-MAKE IT ONE 
CNT+1 OK-SAVE FIELD WIDTH AT COUNT 

4 MOVE OVER FOUR ARGUMENTS 
DONEl-fl CREATE RETURN ADDRESS 

MAKE THE FIELD POSITIVE AND 

SAVE THE ORIGINAL SIGN 
NZONE NZONE TO CLEAR ORIGINAL SIGN 
•-« ADDRESS OF JCARD 
GET ADDRESS OF JLAST 
FOUR ADORE SS OF CONSTANT OF FOUR 
JCRDl AOORESS OF OLD SIGN INDICATOR 
32 CLEAR ACCUMULATOR AND EXTENSION 
126 CLEAR MANTISSA OF FAC 
125 CLEAR CHARACTERISTIC OF FAC 

LET GET AND ANS BE EQUIVALENT 
ESTO STORE THE CONTENTS OF FAC 
ANS AT GET 

JNOW.J 
♦-• LOAD IR1 WITH THE FIELD WIDTH 

JTEST"JCARD(JNOWI 
•-• PICKUP JCARDIJNOWI 
MAYBEt+Z IS JTEST NEGATIVE-YES-MAYBE 
BLANK NO - IS JTEST EQUAL TO AN 
ERRiZ EBCDIC BLANK - NO - GO TO ERR 
ZERO YES - REPLACE BLANK WITH ZERO 
ZERO IS JTEST LESS THAN AN EBCDIC 
ERR. +2 ZERO - YES - GO TO ERR 

JTEST*4032 IN ACCUMULATOR 

GET- 10»GET* ( JTEST+ 4032 1 /256 

SHIFT 8 IS SAME AS DIVIDE BY 256 
8 NO - SHIFT 4 BIT DIGIT TO LOW 
FLOAT ORDER OF ACC AND MAKE REAL 



MDX 

MDX 
ft 

LIBF 
SHIFT DC 

LIBF 

CALL 
JCRD3 DC 
DC 
DC 
DC 



LD 

S 

BSC L 



LDX LI 

BSC L 

DC 

DC 

DC 

SLT 

STD 3 

STO 3 

MDX 

BSS 

BSS 

XFLC 

END 



CSP11S00 
CSP11810 
CSP11B20 
CSP11830 
CSP11840 
CSP11850 
CSP11660 
CSP11S70 
CSP11880 
CSP11S90 
CSP11900 
CSP11910 
CSP11920 
CSP11930 
CSP11940 
CSP11990 
CSP11960 
CSP11970 
CSP11960 
CSP11990 
CSP12000 
CSP12010 
CSP12020 
CSP12030 
CSP12040 
CSP12090 
CSP12060 
CSP12070 
CSP12080 
CSP12090 
CSP12100 
CSP12110 
CSP12120 
CSP12130 
CSP12140 
CSP12150 
CSP12160 
CSP12170 
CSP12180 
CSP12190 
CSP12200 
CSP12210 
CSP12220 
CSP12230 
CSP12240 
CSP12250 
CSP12260 
CSP12270 
CSP12280 
CSP12290 
CSP1230O 
CSP12310 
CSP12320 
CSP12330 
C5P12340 
CSP12350 
CSP12360 



ESTO STORE REAL DIGIT 

TEMP IN TEMPORARY STORAGE 

ELD LOAD FAC WITH 

ANS GET 

EMPY MULTIPLY GET 

ETEN BT TEN 

NORM NORMALIZE THE PRODUCT 

EAOD ADD TEMPORARY STORAGE 

TEMP TO FAC 

ESTO STORE RESULT 

ANS IN GET 

SEE IF JNOW IS LESS THAN JLAST. 

IF YES. JNOW-JNOW+1 AND GO BACK 

FOR MORE. IF NO. PLACE DECIMAL 

POINT. 
-1 DECREMENT FIELD WIDTH 
JCRD2 NOT DONE-GET NEXT DIGIT 

G£T"SHIFT»GET 
EMPY DONE-MULTIPLY BY SHIFT TO PLACE 
•-• AOORESS OF SHIFT—DECIMAL POINT 
NORM NORMALIZE THE RESULT 

REPLACE SIGN OF JCARD 
NZONE RESTORE ORIGINAL JCARD SIGN 
«-» ADDRESS OF JCARD 
GET ADDRESS OF JLAST 
JCRDl ADDRESS OF ORIG. SIGN INDICATOR 
JCR03 DUMMY 

IF INDICATOR EQUALS 2. 

GET—GET. OTHERWISE. EXIT 

JCRDl LOAD OLD SIGN AND SEE IF IT 

TWO+1 WAS NEGATIVE 

FIN.Z IF YES. REVERSE SIGN-NO-EXIT 

GET— GET 
SNR REVERSE THE SIGN OF THE RESULT 

EXIT 

•-» RESTORE IR1 

•-» RETURN TO CALLING PROGRAM 

4 CONSTANT OF FOUR 

/4040 CONSTANT OF EBCDIC BLANK 

/F040 CONSTANT OF EBCDIC ZERO 

32 CLEAR ACCUMULATOR AND EXTENSION 

126 CLEAR MANTISSA OF FAC 

125 CLEAR CHARACTERISTIC OF FAC 

FIN GO TO EXIT 

3 TEMPORARY STORAGE 

3 TEMPORARY STORAGE 



10.0 CONSTANT OF 10.0 (TENI 
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CSP12370 
CSP12380 
CSP12390 
CSP12400 
CSP12410 
CSP 12420 
CSP12430 
CSP12440 
CSP12490 
CSP12460 
CSP12470 
CSP12480 
CSP12490 
CSP12500 
CSP12310 
CSP12520 
CSP12530 
CSP12940 
CSP12530 
CSP12560 
CSP12570 
CSP12580 
CSP12590 
CSP12600 
CSP12610 
CSP12620 
CSP12630 
CSP12640 
CSP126S0 
CSP12660 
CSP12670 
CSP12660 
CSP12690 
CSP12700 
CSP12710 
CSP12720 
CSP12730 
CSP12740 
CSP12790 
CSP12760 
CSP12770 
CSP12760 
CSP12790 
CSP12800 
CSP12810 
CSP12820 
CSP12830 
CSP12840 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICO MP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICQ MP 

IOND 

KEYED 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// OUP 
•STORE 
3371 0007 



US UA 6ET 



CSP12850 
CSP12S60 



// ASM 

•• ICOMP SUBROUTINE 

* NAME ICOMP 

» L[ST 

0000 090D6517 



0000 

0001 

0002 01 
0004 
0009 00 
0007 

oooe o 

0009 
000A 
000B 
000C 00 
OOOE 
000F 

0010 

0011 00 
0013 00 
0019 

0016 

0017 
001S 



0019 00 
001B 
001C 01 
001E 
00 IF 01 
0021 00 

0023 

0024 01 

0026 

0027 01 
0029 
002A 



002B 00 
002D 00 
O02F 00 
0031 00 

0033 

0034 01 

0036 

0037 

0038 

0039 00 



0000 

6972 

63800000 

C10O 

99800002 

D048 

D04A 

800A 

000F 

C103 

95800009 

0046 

8004 

0011 

C9800002 

99800001 

BOFE 

4808 

COFC 

0039 



C4000000 

D09B 

4C100021 

FOOF 

D480001A 

C4000000 

0054 

4C100029 

F007 

04800022 

7106 

694B 



C580FFFE 

9580FFFF 

9580FFFB 

8580FFFC 

80E0 

4C30O04B 

F0F7 

80DA 

O00B 

8380FFFE 



TWO 
ONE 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 1 101 

(ID) 

ENT ICOMP ICOMP SUBROUTINE ENTRV POINT 

• ICOMP I JCARD ■ J. JLAST. KCAH0.K.KLA5T) 

• THE WORDS JCARDIJ) THROUGH 

• JCARDIJLASTI ARE COMPARED TO THE 

• WORDS KCARD IK) THROUGH 
KCARDIKLASTI. 

•-» ARGUMENT ADDRESS COMES IN- HERE 
1 SAVE1+1 SAVE IR1 

II ICOMP PUT ARGUMENT ADDRESS IN IR1 
1 GET JCARD ADDRESS 

II 2 SUBTRACT JLAST VALUE 

JPICl+l STORE JCARDIJLASTI FOR JHASH 
JPIC2+1 STORE JCARDIJLASTI FOR ICOMP 
ONE+1 ADD CONSTANT OF ONE 
SGNJ+1 CREATE AODRESS OF JCARDIJLASTI 
1 3 GET KCARD ADDRESS 

II 9 SUBTRACT KLAST VALUE 

KPIC2+1 STORE KCARDIKLASTI FOR ICOMP 

ONE+1 ADD CONSTANT OF ONE 

SGNK+1 CREATE ADDRESS OF KCARDIKLASTI 

II 2 GET VALUE OF JLAST 

II 1 SUBTRACT VALUE OF J 
ONE+1 ADO CONSTANT OF ONE 
♦ CHECK FIELD WIDTH 
ONE+1 NEGATIVE OR ZERO-MAKE IT ONE 
CNTCO+1 SAVE FIELD WIDTH IN COMP CNT 
CLEAR AND SAVE THE SIGNS ON THE 
JCARD AND THE KCARD FIELDS 

L •-• PICKUP THE SIGN OF JCARD 
JSIGN SAVE IT 

L SGNK.- IS IT NEG-NO-LOOK AT KCARD 
HFFFF+1 YES-MAKE IT POSITIVE AND 

I SGNJ+1 CHANGE JCARD FIELD SIGN 

L •-• PICKUP THE SIGN OF KCARD 
KSIGN SAVE IT 

L CHCKt- IS IT NEG-NO-GO TO CHCK 
HFFFF+1 YES-MAKE IT POSITIVE AND 

I SGNK+1 CHANGE THE KCARD FIELD SIGN 
1 6 MOVE OVER SIX ARGUMENTS 
1 D0NE1+1 CREATE RETURN AODRESS 

K IS COMPARED TO 
KSTRT«KLAST+J-JLAST-1 

II -2 PICKUP THE VALUE OF K 
II -I SUBTRACT THE VALUE OF KLAST 
II -9 SUBTRACT THE VALUE OF J 
II -4 ADD THE VALUE OF JLAST 

ONE+1 ADD CONSTANT OF ONE 
L JHASHi-Z IF POSITIVE GO TO JHASH 

HFFFF+1 OTHERWISE COMPLIMENT AND ADD 
A TWO+1 ONE GIVING LEADING PART KCARD 
STO ZIPCT+1 STORE THIS COUNT AT ZIPCT 
A 11-2 ADD VALUE OF K 



ICOMP DC 
STX 
LDX 
LD 
S 

STO 
STO 
A 

STO 
LD 
S 

STO 
A 

STO 
LD 
S 
A 

BSC 
LD 
STO 



SGNJ LD 
STO 
BSC 
EOR 
STO 

SGNK LD 
STO 
BSC 
EOR 
STO 

CHCK MDX 
STX 



LD 

HFFFF S 
S 
A 
A 

BSC 
EOR 



CSP12870 
CSP128S0 
CSP12890 
CSP12900 
CSP12910 
CSP12920 
CSP12930 
CSP12940 
CSP12950 
CSP12960 
CSP12970 
CSP12980 
CSP12990 
CSP13000 
CSP13010 
CSP13020 
CSP13030 
CSP13040 
CSP1309O 
CSP13060 
CSP13070 
CSP13080 
CSP13090 
CSP13100 
C5P13H0 
CSP131Z0 
CSP13130 
CSP13140 
CSP13150 
CSP13160 
CSP13170 
CSP13180 
CSP13190 
CSP13200 
CSP13210 
CSP13220 
CSP13230 
CSP13240 
CSP13290 
CSP13260 
CSP13270 
CSP13280 
CSP13290 
CSP13300 
CSP13310 
CSP13320 
CSP13330 
CSP13340 
CSP13330 
CSP13360 
CSP13370 
CSP13380 
CSP13390 
CSP1340C 
CSP13410 
CSP13420 
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003B 


9008 




S 




003C 


D0C3 




STO 




DO 3D 


C1FD 




LD 


1 


003E 


90C1 




S 




00 3F 


D006 


* 


STO 




0040 


C037 


* 


LD 




0041 


FOEC 




EOR 




0042 


OOBO 




STO 




0043 00 


65000000 


Z1PCT 


LDX 


LI 


0045 00 


C5000000 


KP1C1 


LD 


LI 



0047 01 4C30006C 



0049 

00 4A 






71FF 

70FA 




MDX 
MDX 


1 


004B 
004C 






1810 
D0B3 


JHASH 


SRA 
STO 




004D 


00 


65000000 


CNTCO 

* 

JPIC1 

JPIC2 
KPIC2 


LDX 


LI 


004F 
0091 


00 



85000000 
1690 


A 

SRT 


LI 


0052 
0054 
0056 


00 

00 



C5000000 
95000000 
D0A9 


LD 

S 

STO 


LI 
LI 


0057 
0059 


01 



4C200063 
1090 




BSC 
SLT 


L 



00 5A 


71FF 




MDX 


005B 


70F3 




MDX 


005C 01 


4C18006C 




BSC 


005E 


C01S 




LD 


005F 


F018 




EOR 


0060 01 


4C10006C 




BSC 


0062 


7004 




MDX 


0063 


C013 


NEQ 


LD 


0064 


F013 




EOR 


0065 01 


4C100069 




BSC 



0067 C0E5 



0068 D097 



0069 


C096 


0VR2 


LD 


006A 


FOOC 




EOR 


006B 


D094 


* 


STO 


00 6C 


COOA 


* 
FIN 


LD 


006D 01 


D480001A 




STO 


006F 


COOS 




LD 


0070 01 


D4800022 




STO 


0072 


C08D 




LD 


0073 00 


65000000 


SAVE1 


LDX 


0075 00 


4C0OOO00 


D0NE1 


BSC 


0077 


0000 


JSIGN 


DC 


0078 


0000 


KSIGN 


DC 


00 7A 






END 



ONE+1 SUBTRACT CONSTANT OF ONE 

ICOMP STORE TEMPORARILY 

-3 SET KCARD ADDRESS 

ICOMP SUBTRACT TEMPORARY VALUE GIVING 

KPIC1+1 ADDR FOR SEARCHING BEGINNING 

OF KCARD 

ICOMP — KSIGN 
KSIGN LOAD SIGN OF KCARD 
HFFFF+1 NEGATE IT 
ICOMP STORE IT IN ICOMP 

KNOW'K 
*-» LOAD IR1 WITH BEGINNING KCARD CT 
»-» PICKUP KCARDIKNOW) 

IS KCARD I KNOW) POSITIVE 
FIN. -Z IF POSITIVE. GO TO FIN 

SEE IF KNOW IS LESS THAN KSTRT. 

IF YES. KNOWKNOW+1 AND LOOK AT 

NEXT KCARD WORD. IF NO. GO TO 

JHASH. 
-1 OTHERWISE. DECREMENT FIELD WIDTH 
KPIC1 NOT DONE-GO BACK FOR NEXT DIGIT 

JHASH-0 
16 DONE-CLEAR ACCUMULATOR 
ICOMP CLEAR ICOMP 

KNOW-KSTRT+1 

KSTRT-J 
«-« LOAD IR1 WITH FIELD WIDTH 

JHASH-JHASH+JCARDI KSTRT I 
♦-« ADD JCARD(KSTRT) TO JHASH 
16 STORE JHASH IN EXTENSION 

ICOMP- JCARD I KSTRT) -KCARD (KNOW] 
*-* LOAD JCARDI KSTRT! 
«-* SUBTRACT KCARDIKNOWI 
ICOMP S T ORE RESULT 

IS ICOMP ZERO - NO - GO TO NEQ 
NEO.Z IF NOT ZERO. GO TO NEQ. 
16 OTHERWISE. PUT JHASH IN ACCUM 

KN0W>KN0W*1 

SEE IF KSTRT IS LESS THAN JLAST. 

IF YES. KSTRT«KSTRTtl AND TRY 

NEXT PAIR OF DIGITS. IF NO. 
-1 DECREMENT F I ELO WIDTH 
JPIC1 NOT DONE - GO BACK 
IF NO IS JSIGN«KSIGN«JHASH NEGATIVE. 
FIN.+- OONE-IF JHASH IS ZERO GO FIN 
JSIGN OTHERWISE - COMPUTE JSIGN 
KSIGN TIMES KSIGN 
FIN.- IF NOT NEGATIVE. GO TO FIN 
0VR1 OTHERWISE GO TO 0VR1 

IS KSIGN«JSIGN NEGATIVE 
JSIGN COMPUTE JSIGN 
KSIGN TIMES KSIGN 
0VR2.- IF NOT NEGATIVE. GO TO 0VR2 

ICOMP -1 
CNTCO OTHERWISE. SET ICOMP 



ICOMP TO A POSITIVE NUMBER 

ICOMP-JSIGN«ICOMP 
ICOMP LOAD ICOMP AND 
JSIGN MULTIPLY BY JSIGN 
ICOMP STORING THE RESULT IN ICOMP 

RESTORE THE SIGNS ON THE JCARD 

AND THE KCARD FIELDS 
JSIGN RESTORE THE ORIGINAL 
SGNJ+1 SIGN OF JCARD 
KSIGN RESTORE THE ORIGINAL 
SGNK + 1 SIGN OF KCARO 
ICOMP PUT ICOMP IN THE ACCUMULATOR 

EXIT 
»-♦ RESTORE IR1 
«-• RETURN TO CALLING PROGRAM 
«-« SIGN OF JCARD 
•-» SIGN OF KCARD 
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CSP13430 
CSP13440 
CSP13450 
CSP13460 
CSP13470 
CSP13480 
CSP13490 
CSP13500 
CSP13510 
CSP13520 
CSP13530 
CSP13540 
CSP13550 
CSP13560 
CSP13570 
CSP13580 
CSP13590 
CSP13600 
CSP13610 
CSP13620 
CSP13630 
CSP13640 
CSP13650 
CSP13660 
CSP13670 
CSP13680 
CSP13690 
CSP13700 
CSP13710 
CSP13720 
CSP13730 
CSP13740 
CSP13750 
CSP13760 
CSP13770 
CSP13780 
CSP13790 
CSP13800 
CSP13810 
CSP13B20 
CSP13830 
CSP13640 
CSP13850 
CSP13860 
CSP13870 
CSP13880 
CSP13890 
CSP13900 
CSP13910 
CSP13920 
CSP13930 
CSP13940 
CSP13950 
CSP13960 
CSP13970 
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CSP13980 
CSP13990 
CSP14Q00 
CSP14010 
CSP1402O 
CSP14030 
CSP14040 
CSP14050 
CSP14060 
CSP14070 
CSP14080 
CSP14090 
CSP14100 
CSP14110 
CSP14120 
CSP14130 
CSP14140 
CSP14150 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 



II DUP 
•STORE 
3378 0008 



WS UA ICOMP 



CSP14160 
CSP14170 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 






•• IOND 


SUBROUTINE 


FOR 1130 COI 


• NAME 


IOND 




• LIST 






0000 


09595100 


ENT 
•CALL IOND 
•CALL IOND 


0000 


0001 


IOND BSS 


0001 00 


74000032 


IOPND MDX 


0003 


70FD 


MDX 


0004 01 


4C800000 


BACK BSC 


0006 




END 



IOND SUBROUTINE NAME 
NO PARAMETERS 

ALLOWS I/O OPERATIONS TO END BEFORE 
PAUSE OR STOP IS ENTERE0 
1 AR0UMENT AD0RESS 

50.0 ANY INTERRUPTS PENDIN0 
IOPND VES - KEEP CHECKING 
IOND NO - RETURN TO CALLING PRG CSP14290 

CSP14300 



CSP14180 
1 101 C5P14190 
IIDI CSP14200 
CSP14210 
CSP14220 
CSP14230 
CSP14240 
CSP14250 
CSP14260 
CSP14270 
CSP142S0 



NO ERRORS IN ABOVE ASSEMBLY. 



// DJP 
•STORE 
3390 0002 



W5 UA IOND 



CSP14310 
CSP14320 



// ASM 

•• MOVE SUBROUTINE 

• NAME MOVE 

• LIST 

0000 14SA5140 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



IIDI 
I ID) 



0000 





0000 


0001 





691F 


0002 


01 


65800000 


0004 





C100 


0005 


00 


95800002 


0007 





0013 


0008 


00 


C58000O2 


OOOA 


00 


95800001 


000C 





4828 


000D 





1810 


000E 





DOOA 


00 OF 





C103 


0010 


00 


95800004 


0012 





9006 


0013 





0009 


0014 


01 


74010019 


0016 





7103 


0017 





690B 



MOVE DC 
STX 
LDX 
LO 
S 
STO 

tt 

LO 

ONE S 

BSC 

5RA 

STO 

LD 

S 

S 

STO 

MDX 

MDX 

STX 



II 2 

II 1 



+ Z 
16 



0018 00 65000000 



0O1A 00 
001C 00 


C5OOOOO0 
D5000000 


LD1 
STO 

It 


LD 
STO 


LI 
LI 


*-* 


001E 
001F 


71FF 
70FA 


tt 


MDX 
MDX 


1 


-1 
LD1 


0020 00 
0022 00 
0024 


65000000 
4C000000 


SAVE1 

0ONE1 


LDX 
BSC 
END 


LI 
L 


• -• 

*-• 



MOVE MOVE SUBROUTINE ENTRY POINT 

CALL MOVEIJCARD.J. JLAST. KCARO.KI 
THE WORDS JCARDIJI THROUGH 
JCARDIJLASTI ARE MOVED TO KCARD 
STARTING AT KCARDIKI. 
•-• ARGUMENT ADDRESS COMES IN HERE 
1 SAVE1-H SAVE IR1 
II MOVE PUT ARGUMENT ADDRESS IN IR1 

1 GET JCARD ADDRESS 
II 2 SUBTRACT JLAST VALUE 

LDH-1 PLACE ADDR OF JCARDIJLASTI IN 
PICKUP OF MOVE 
GET JLAST VALUE 
SUBTRACT J VALUE 
CHECK FIELD WIDTH 
NEGATIVE - MAKE IT ZERO 
LDXtl STORE FIELD WIDTH IN LDX 

3 GET KCARD ADDRESS 

4 SUBTRACT K VALUE 
LDX+1 SUBTRACT FIELD WIDTH 
STO+1 PLACE ADDR OF KCARDIKLASTI IN 

STORE OF MOVE 
LDX+1. 1 ADD ONE TO FIELD WIDTH 
MAKING IT TRUE 

5 MOVE OVER FIVE ARGUMENTS 
DONEH-1 CREATE RETURN ADDRESS 

JNOW-J 

KNOW-K+JNOW-J 

LOAD IR1 WITH FIELD WIDTH 

KCARD (KNOW I -JCARD I JNOW I 

PICKUP JCARD I JNOW I 

STORE IT IN KCAROIKNOWI 

SEE IF JNOW IS LESS THAN JLAST. 

IF YES. JNOW-JNOW+1 AND MOVE 

NEXT CHARACTER. IF NO. EXIT... 

DECREMENT THE FIELD WIDTH 

NOT DONE - GET NEXT WORD 

EXIT 

DONE - RESTORE IR1 
RETURN TO CALLING PROGRAM 



LDX LI •-• 



CSP14330 
CSP14340 
CSP14350 
CSP14360 
CSP14370 
CSP14380 
CSP14390 
CSP14400 
CSP14410 
CSP14420 
CSP14430 
CSP14440 
CSP14450 
CSP14460 
CSP14470 
CSP14480 
CSP14490 
C5P14500 
CSP14510 
CSP14520 
CSP14330 
CSP14540 
CSP14550 
CSP14560 
CSP14570 
CSP145B0 
CSP14590 
CSP14600 
CSP14610 
CSP14620 
CSP14630 
CSP14640 
CSP14650 
C5P14660 
CSP14670 
CSP14680 
CSP14690 
CSP14700 
CSP14710 
CSP14720 
CSP14730 
CSP14740 
CSP14750 
CSP14760 
CSP14770 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
3382 0003 



WS UA MOVE 



CSP14780 
CSP14790 
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// ASM 

•» MPY SUBROUTINE 

• NAME MPY 

• LIST 

0000 145E8000 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



( ID) 

110) 



0000 





0000 MPY DC 




0001 





6A6A 


STX 


2 


0002 





696B 


STX 


1 


0003 


01 


69800000 


LDX 


11 


0009 





C104 


LD 


1 


0006 





DOSE 


STO 




OOOT 


01 


C4800065 


LD 


I 


0009 





900B 


S 




00 OA 





D0F5 


STO 




OOOB 





C100 


LO 


1 


OOOC 


00 


95800002 


S 


11 


OOOE 





004E 


STO 




OOOF 





DOTS 


STO 




0010 





8004 


A 




0011 





D02F 


STO 




0012 


00 


CS800002 TWO LO 


11 


0014 


00 


9S800001 ONE S 


11 


0016 





80FE 


A 




0017 





4808 


BSC 




0016 





COFC 


LD 




0019 





D024 


STO 




00 1A 





C103 


LD 


1 


00 IB 





003C 


STO 




00 1C 





0047 


STO 




001D 





DO 74 


STO 




001E 


00 


9580000S 


S 


11 


0020 





0094 


STO 




0021 





D099 


STO 




0022 





80F2 


A 




0023 





D027 


STO 




0024 





C10S 


LD 


1 


0029 





D06E 


STO 




0026 





D03F 


STO 




0027 


00 


CS800005 


LD 


11 


0029 


00 


95800004 


S 


11 


002B 





80E9 


A 




002C 





4806 


BSC 




002D 





C0E7 


LD 




002E 





D043 


STO 




002F 





7107 


MDX 


1 


0030 





693F 


STX 


1 


0031 





COCE 


LO 




0032 


00 


8980FFFA 


A 


11 


0034 


00 


9580FFFB 


S 


11 



MPY MPY SUBROUTINE ENTRY POINT 
CALL MPY(JCARD.J.JLAST.KCARD.K.KLAST.NER) 
THE WORDS JCARDIJI THROUGH 
JCARDIJLASTI MULTIPLY THE WORDS 
KCARDIKI THROUGH KCARDI KLAST I . 
THE RESULT IS IN THE KCARD FIELD 
EXTENDED TO THE LEFT. 

«-« ARGUMENT ADDRESS COMES IN HERE 

SAVE2+1 SAVE IR2 

SAVE1+1 SAVE IR1 

MPY PUT ARGUMENT ADDRESS IN IR1 

4 GET K ADDRESS 
Kl STORE FOR FILL OF ZEROES 

CALCULATE K-l 
Kl GET VALUE OF K 
ONE+1 SUBTRACT CONSTANT OF ONE 
MPY STORE IN MPY 

GET JCARD ADDRESS 
2 SUBTRACT JLAST VALUE 
SRCH+1 SAVE FOR JFRST SEARCH 
MULT1+1 SAVE FOR MULTIPLICATION 
ONE+1 ADD CONSTANT OF ONE 
OK+2 CREATE ADDRESS OF JCARDIJLASTI 

2 GET JLAST VALUE 

1 SUBTRACT J VALUE 
ONE+1 ADO CONSTANT OF ONE 
♦ CHECH FIELD WIOTH 
ONE+1 NEGATIVE OR ZERO-MAKE IT ONE 
SCHCT+1 SAVE FIELD WIDTH FOR SEARCH 

3 GET KCARD ADDRESS 
KCRD1 SAVE FOR FILL 
KCRD2 SAVE FOR FILL 
KCRD3 SAVE FOR CARRY 

3 SUBTRACT JLAST VALUE 
PICK+1 SAVE FOR MULTIPLICATION 
PUT1+1 SAVE FOR MULTIPLICATION 
ONE+1 ADD CONSTANT OF ONE 
SGNK+1 CREATE ADDRESS OF KCARDIKLASTI 

5 GET KLAST ADDRESS 
KLAS2 SAVE FOR CARRY 
KLAS1 SAVE FOR FILL 
5 GET KLAST VALUE 

4 SUBTRACT K VALUE 
ONE+1 ADO CONSTANT OF ONE 
+ CHECK FIELD WIDTH 
ONE+1 NEGATIVE OR ZERO-MAKE IT ONE 
MULTC+1 SAVE FOR MULTIPLICATION 
7 MOVE OVER SEVEN ARGUMENTS 
D0NE1+1 CREATE RETURN AODRESS 

KSTRT-K-JLAST+J-1 
MPY LOAD K-l 
-6 ADD VALUE OF J 
-5 SUBTRACT VALUE OF JLAST 



CSP14800 
CSP14610 
CSP14820 
CSP14830 
CSP14840 
CSP14850 
CSP14860 
CSP14870 
CSP14880 
CSP14690 
CSP14900 
CSP14910 
CSP14920 
CSP14930 
CSP14940 
CSP14950 
CSP14960 
CSP14970 
CSP14960 
CSP14990 
CSP15000 
CSP15010 
CSP15020 
CSP19030 
CSP1S040 
CSP15050 
CSP15060 
CSP15070 
CSP15080 
CSP15090 
CSP15100 
CSP15110 
CSP15120 
CSP15130 
CSP15140 
CSP15150 
CSP1S160 
CSP15170 
CSP15180 
CSP19190 
CSP15200 
CSP1S210 
CSP15220 
CSP15230 
CSP15240 
CSP192S0 
CSP15260 
CSP15270 
CSP13280 
CSP15290 
CSP1S300 
CSP15310 
CSP15320 
CSP15330 
CSP15340 
CSP15350 
CSP1S360 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



0036 01 4C 300030 



0036 


00 


C580FFFE 




ID 


11 


003A 


00 


D560FFFF 


M0NE 


5T0 


11 


00 3C 





7030 




MDX 




0030 


00 


65000000 


SCHCT 


LDX 


LI 


00 3F 





00FE 


OK 


STO 




0040 


00 


C4000000 


* 


LD 


L 


0042 





00SC 




STO 




0043 


01 


4C100049 




esc 


L 


0043 





F0F5 




EOR 




0046 


01 


04600041 




STO 


1 


0046 





C0F2 




LD 




0049 





1890 


OVRJ 


SRT 




004* 


00 


C4000000 


SGNK 


LD 


L 


004C 


01 


4C100054 




BSC 


L 


004E 





F0EC 




EOR 




004F 


01 


0480004B 




STO 


I 


0091 





1090 




SLT 




0052 





F0E6 




EOR 




0093 





7001 




MDX 




0054 





1090 


KPLUS 


SLT 




0039 





004A 


OVRK 

• 


STO 




0056 


30 


062534C0 


ft 


CALL 




0058 





0000 


KCRD1 


DC 




0059 


1 


003E 




DC 




005A 


1 


oooo 




DC 




005B 


1 


00A1 


* 
5RCH 


DC 




00 50 


00 


C5000000 


LO 


LI 


005E 


01 


4C3000T1 




BSC 


L 



0060 

0061 



TIFF 
70FA 



0062 30 062334C0 

0064 0000 

0065 0000 

0066 0000 

0067 1 OOAl 



0066 C036 
0069 01 04600041 
006B 00 66000000 
0060 00 65000000 



MDX 
MDX 



CALL 
KCRD2 DC 
Kl DC 
KLAS1 DC 

DC 



FIN LD 

STO 
SAV:2 LDX 
SAVE1 LDX 



SCHCTi-Z IF KSTRT POSITIV-GO TO SCHCT 

NER-KLAST 
-2 NOT POSITIVE-LOAD KLAST VALUE 
-1 AND STORE AT NER 
SAVE1 GO TO EXIT 

JFRST-J 
H »-ft LOAO IR1 WITH JCARD FIELD WIDTH 
SCHCT+1 SAVE KSTRT IN SCHCT+1 

CLEAR AND SAVE THE SIGNS ON THE 

JCARD AND THE KCARD FIELDS 
»-» GET JCARD(JLAST) VALUE 
JSIGN SAVE SIGN IN JSIGN 
OVRJ.- IF NOT NEGATIVE-60 TO OVRJ 
MONE+1 NEGATIVE-MAKE SIGN POSITIVE 
OK+2 AND PUT BACK IN JCARDIJLASTI 
MONE+1 PICKUP A MINUS ONE 
16 PUT JSIGN INDICATION IN EXTENTON 
•-» PICKUP KCARD(KLAST) 
KPLUS.- IF NOT NEGATIVE-GO TO KPLUS 
MONE+l NEGATIVE-MAKE POSITIVE AND 
SGNK+1 PUT BACK IN KCARDIKLASTI 
16 GET JSIGN INDICATION 
MONE+1 CHANGE IT 
OVRK SKIP THE NEXT INSTRUCTION 
16 GET JSIGN INDICATION 
KSIGN SAVE SIGN FOR RESULT 

FILL LEFT EXTENSION OF KCARD 

WITH ZEROES 
FILL FILL KCARD EXTENSION WITH ZEROES 
*-* ADDRESS OF KCARD 
SCHCT+1 ADDRESS OF KSTRT 
MPY ADDRESS OF K-l 
ZIP ADORESS OF ZERO 

IS JCARDIJLASTI POSITIVE 
«-• PICKUP JCARDIJFRSTI 
MULTC.-Z IF POSITIVE-GO TO MULTC 

SEE IF JFRST IS LESS THAN JLAST . 

IF YES. JFRST-JFRST+1 AND GO 

BACK FOR MORE. IF NO. 

MULTIPLICATION IS BY ZERO. 
1 -1 NOT POSITIVE-DECREMENT IR1 
SRCH NOT DONE - GO BACK FOR MORE 

FILL WITH ZERO SINCE MULTIPLIER 

IS ZERO 
FILL DONE-MAKE ENTIRE RESULT ZERO 
*-• ADDRESS OF KCARD 
*-• ADDRESS OF K 
•-* ADDRES5 OF KLAST 
ZIP ADDRESS OF ZERO 

RESTORE THE SIGN OF JCARD 

EXIT... 

JSIGN PICKUP JCARD SIGN 
I OK+2 AND RESTORE IT 
L2 •-» RESTORE IR2 
LI •-» RESTORE IR1 



PAGE 2 

CSP15370 
CSP15380 
CSP15390 
CSP15400 
CSP1S410 
CSP15420 
CSP15430 
CSP15440 
CSP15450 
CSP15460 
CSP15470 
CSP15480 
CSP15490 
CSP15500 
CSP15510 
CSP15520 
CSP15530 
CSP15540 
CSP15550 
CSP15560 
CSP15570 
CSP15580 
CSP15590 
CSP15600 
CSP15610 
CSP15620 
CSP15630 
CSP15640 
CSP13650 
CSP15660 
CSP15670 
CSP15680 
CSP15690 
CSP157O0 
CSP15710 
CSP15720 
CSP15730 
CSP15740 
CSP15750 
CSP15760 
CSP15770 
CSP15780 
CSP15790 
CSP15800 
CSP15810 
CSP15B20 
CSP15830 
CSP15840 
CSP15850 
CSP15660 
CSP15870 
CSP158B0 
CSP15690 
CSP15900 
CSP15910 
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006F 


00 


4C00O0OO 


D0NE1 
MULTC 


BSC 


L 


0071 


00 


86000000 


LDX 


L2 


0073 





69F1 


# 
PICK 


5TX 


1 


0074 


00 


C6000000 


LD 


L2 


0076 


01 


4C08008E 




BSC 


L 


0078 





DOED 




STO 




0079 





1810 




SRA 




00 7A 


00 


06000000 


PUT1 


STO 


L2 


00 7C 





6AF5 




STX 


2 


00 7D 





C0F4 




LO 




00 7E 





80E6 




A 




007F 





8066 




A 




0080 





SOFA 




A 




0081 





D007 




STO 





Kl 



MO. 



0082 01 65800069 



LDX U Kl 



0084 00 


C5000000 


M0LT1 LD 


0086 


AODF 


M 


0087 


1090 


SLT 


0088 00 


04000000 


PUT2 STO 



008A 01 74FF0089 



008C 





71FF 




MDX 


008D 





70F6 


• 
ft 
« 
MO 


MDX 


008E 





72FF 


MDX 


00 8F 





70E4 




MDX 


0090 


30 


03099668 




CALL 


0092 





0000 


KCRD3 


DC 


0093 


1 


003E 




DC 


0094 





0000 


KLAS2 


DC 


0099 


l 


0092 




DC 


0096 





C009 




LD 


0097 


01 


4C 100068 




BSC 


0099 


01 


C480004B 




LD 


0096 





F09F 




EOR 


009C 


01 


D480004B 




STO 


009E 





70C9 




MDX 


009F 





0000 


JSIGN 


DC 


OOAO 





0000 


KSIGN 


DC 


00A1 





0000 


ZIP 


DC 


00A2 








END 



RETURN TO CALLING PROGRAM 
KM-K 

POSITIVE-LOAD IR2 WITH KCARD CNT 
SAVE JFRST AT Kl 
MULT-KCARDIKM) 
PICKUP KCARD(KM) 
IS IT POSITIVE-NO-GO TO MO 
KLAS1 YES-SAVE KCARDIKMI 
16 CLEAR ACCUMULATOR 

KCARDIKMI-O 
»-• SET KCARDIKMJ-0 

KNOW-KM+JFRST-JLAST 
MULTC+1 GET THE VALUE 
MULTC+l OF KM 
Kl AND ADD JFRST 
MONE+l TO IT AND CALCULATE 
PUT1+1 THE ADDRESS OF 
PUT2+1 KCARD (KNOW I 
JNOW«JFRST 
LOAD IR1 WITH JFRST 
KCARD < KNOW I -MULToJCARD ( JNOW I 

+KCARDIKNOWI 
*-« PICKUP JCARDIJNOWI 
KLAS1 MULTIPLY BY MULT 
16 RE-ALIGN THE PRODUCT 
•-• STORE IN KCARD(KNOW) 

KNOK.KNOW+l 
PUT2+1.-1 MODIFY ADDR OF KCARDiKNOWl 
SEE IF JNOW IS LESS THAN JLAST. 
IF YES. JNOW'JNOW+1 AND GO BACK 
FOR MORE. IF NO. CHECK KM. 
-1 DECREMENT IR1 
MULT1 NOT DONE-GO BACK FOR MORE 

SEE IF KM IS LESS THAN KLAST. 
IF YES. KM-KM+1 AND GO BACK FOR 
MORE. IF NO. RESOLVE CARRIES. 
-1 DONE-DECREMENT IR2 
PICK NOT DONE-GO BACK FOR MORE 

RESOLVE CARRIES IN THE PRODUCT 
CARRY DONE-RESOLVE CARRIES IN THE RES 
«-* ADDRESS OF KCARD 
SCHCT+1 AODRESS OF KSTRT 
»-* ADDRESS OF KLAST 
KCR03 DUMMY 

GENERATE THE SIGN OF THE PRODUCT 
KSIGN PICKUP THE SIGN INDICATOR 
FIN.- IF NOT NEGATIVE-ALL DONE-EXIT 
S6NK+1 NEGATIVE-PICKUP KCARDIKLASTI 
MONE+1 CHANGE THE SIGN 
SGNK+1 RESTORE KCARDIKLASTI 
FIN GO TO EXIT 
*-« SIGN OF JCARD 
«-» SIGN OF PRODUCT 
CONSTANT OF ZERO 



PAGE 3 

CSP15920 

CSP15930 

CSP15940 

CSP15950 

CSP19960 

CSP15970 

CSP15980 

CSP19990 

CSP16000 

CSP16010 

CSP16020 

CSP16030 

CSP16040 

CSP16050 

CSP16060 

CSP16070 

CSP16080 

CSP16090 

CSP16100 

CSP16110 

CSP16120 

CSP16130 

CSP16140 

CSP161S0 

CSP16160 

CSP16170 

CSP16180 

CSP16190 

CSP16200 

CSP16210 

CSP16220 

CSP16230 

CSP16240 

CSP16250 

CSP16260 

CSP16270 

CSP16280 

CSP16290 

CSP16300 

CSP16310 

CSP16320 

CSP16330 

CSP16340 

CSP16350 

CSP16360 

CSP16370 

CSP16380 

CSP16390 

CSP16400 

CSP16410 

CSP16420 

CSP16430 

CSP16440 

CSP16490 

CSP16460 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
3389 OOOA 



WS UA MPY 



CSP16470 
CSP16480 



ADD 
A1A3 
A1DEC 
A3A1 
CARRY 
DECA1 
DIV 
DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYED 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 

•• NCOMP SUBROUTINE 

» NAME NCOMP 

« LIST 

0000 150D6517 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 
(IDI 



0000 
0001 
0002 
0004 
0005 
0007 
0008 
000A 

oooc 

00OD 
000E 
000F 
00 10 
0012 
0013 
0014 
0016 
0017 



0000 

6925 

01 65600000 
C100 

00 95800002 
0017 
00 C5S00002 
00 95900001 
4828 
1810 
DOOA 
C103 
00 9580000'! 
9006 

0007 

01 74010019 
7105 

6911 



0016 00 65000000 
001A 00 C5000000 
0O1C 1804 
0010 OOFB 
001E 00 C5000000 

0020 1804 

0021 90F7 

0022 01 4C20OO26 



0024 71FF 

0025 70F4 

0026 00 65000000 
0028 00 4C0OOO00 
O02A 



NCOMP DC 
STX 
LDX 
LO 
S 

STO 
LD 

ONE S 

BSC 

SRA 

STO 

LD 

S 

s 

STO 

MDX 
MDX 
STX 



LDX LDX 
LD2 LD 
SRA 
STO 
L01 LD 
SRA 
S 
BSC 



MDX 
MDX 
* 

SAVE1 LDX 

DONE1 BSC 

END 



II 



NCOMP NCOMP SUBROUTINE ENTRY POINT 
NCOMP IJCARD. J i JLAST. KCARO.K! 
THE WORDS JCARDIJI THROUGH 
JCARDIJLASTI STARTING WITH 
JCARDIJI ARE COMPARED LOGICALLY 
TO THE FIELD STARTINO AT 
KCARDIK1. ALL DATA MUST BE IN 
Al FORMAT. 
«-* ARGUMENT ADDRESS COMES IN HERE 
1 SAVE 1+1 SAVE IR1 
II NCOMP PUT ARGUMENT ADDRESS IN IR1 
1 GET JCARD ADDRESS 
2 SUBTRACT JLA5T VALUE 
LD1 + 1 CREATE END OF JCARD ADDRESS 

2 SET JLAST VALUE 
1 SUBTRACT J VALUE 
+Z CHECK FIELD WIDTH 
16 NEGATIVE - MAKE IT ZERO 
LDX+1 SAVE FIELD WIDTH 

3 GET KCARD ADDRESS 

4 SUBTRACT K VALUE 
LDX+1 SUBTRACT FIELD WIDTH 
LD2 + 1 CREATE END OF KCARD ADDRESS 
LDX+lil MAKE FIELD WIDTH TRUE 

5 MOVE OVER FIVE ARGUMENTS 
DONEl+l CREATE RETURN ADDRESS 

JNOW'J 

KN0W"K+JN0W-J 
•-« PUT FIELD WIDTH IN IR1 
*-* PICKUP JCARD<JNOW> 
4 DIVIDE BY EIGHT 
LOX+1 SAVE TEMPORARILY 
PICKUP KCARDIKNOWI 
DIVIDE BY EIGHT 
LDX+1 CALCUL JCAROI JNOW)-KCARD(KNOW> 
L SAVE1.Z IS NCOMP ZERO-NO-ALL DONE 

SEE IF JNOW IS LESS THAN JLAST. 
IF YES. JNOW«JNOW+l AND GO BACK 
FOR MORE. IF NO. EXIT. 
1 -1 YES-DECREMENT FIELD WIDTH 
LD2 GO BACK FOR MORE 

ALL DONE - - EXIT 

Ll'»-« RESTORE IRl 

L •-* RETURN TO CALLING PROGRAM 



LI •- 



CSP16490 
CSP1650O 
CSP16510 
CSP16520 
CSP16530 
CSP16540 
CSP16550 
CSP16560 
CSP16570 
CSP16580 
CSP16590 
CSP16600 
CSP16610 
CSP16620 
CSP16630 
CSP16640 
C5P16650 
CSP16660 
CSP16670 
CSP16680 
CSP16690 
CSP16700 
CSP16710 
CSP16720 
CSP16730 
CSP16740 
CSP16750 
CSP16760 
CSP16770 
CSP16780 
CSP16790 
CSP16800 
CSP16810 
CSP16820 
CSP16830 
CSP16840 
CSP16850 
CSP16860 
CSP16870 
CSP16SS0 
CSP16S90 
CSP1690O 
CSP16910 
CSP16920 
CSP16930 
. CSP16940 
CSP16950 
CSP16960 
CSP16970 



NO ERRORS IN ABOVE ASSEMBLY. 



// OUP 
•STORE 
338F 0004 



WS UA NCOMP 



CSP169SO 
CSP16990 



-176- 



// ASM 

I*M^ B |3cf^ R0UTINE F0R U3 ° COMMERCIAL SUBROUTINE PACKAGE 

* NAME NSIGN 

• LIST 

OOOO 15889105 EN' 



< ID ) 

(IDI 



0000 0000 

0001 691A 

0002 01 65800000 
0004 C100 
0009 00 95800001 

0007 80FE 

0008 0001 

0009 00 C4000000 
OOOB 01 4C10001F 
OOOD 1890 

OOOE C019 
OOOF 00 D5800003 



0011 00 C580OOO2 
0013 01 4C2B0019 



0015 

0016 



1090 
F011 



0017 01 D4600OOA 

0019 7104 
001A 6903 

001B 00 65000000 
001D 00 4C0O0OO0 
001F 1890 

0020 C0E5 

0021 00 D5800003 



0023 00 C5800002 
0025 01 4C300019 
0027 70EO 
002S FFFF 
002A 



NSIGN DC 
STX 
LDX 
LD 

ONE S 



ID 

BSC 

SRT 

LD 
STO 



LD 
BSC 

SLT 
EOR 

STO 
MDX 
STX 



SAVE! LDX 
DON";! BSC 
PLUS SRT 

# 

LD 
STO 



LD 
BSC 
MDX 
HFFFF DC 
END 



NSIGN NSIGN SUBROUTINE ENTRY POINT 
CALL NSIGNIJCARD. J.NEWS. NOLDSI 
THE SIGN OF THE DIGIT AT 
JCARDIJI IS TESTED AND NOLDS IS 
SET. THE SIGN IS MODIFIED AS 
INDICATED BY NEWS. 
»-« ARGUMENT ADDRESS COMES IN MERE 
1 SAVE1+1 SAVE IR1 
II NSIGN PUT ARGUMENT ADDRESS IN IR1 
1 GET JCARD ADDRESS 

1 SUBTRACT J VALUE 
ONE+1 ADD CONSTANT OF ONE 
CHAR-H CREATE JCARDIJI ADDRESS 

JTEST"JCARD(JI 
*-» PICKUP DIGIT 

PLUS.- IS JTEST NEGATIV-NO-GO TO PLUS 
16 YES-SAVE TEMPORARILY 

NOLDS — 1 
HFFFF PICKUP MINUS ONE 

3 STORE IN NOLDS 

NEWS*JTEST IS COMPARED TO 2ER0 
NEWS IS COMPARED TO ZERO 

2 PICKUP NEWS 

FIN, +2 IF NEGATIVE ALL DONE 

JTEST--JTEST-1 
16 RESTORE JTEST 
HFFFF CHANGE THE SIGN 

JCARDIJ1-JTEST 
CHAR+1 PUT NEW SIGN IN JCARDIJI 

4 MOVE OVER FOUR ARGUMENTS 
D0NE1+1 CREATE RETURN ADDRESS 

EXIT 

*-• RESTORE IR1 

RETURN TO CALLING PROGRAM 

SAVE TEMPORARILY 

NOLDS-1 
ONE+1 PICKUP CONSTANT OF ONE 

3 STORE IT IN NOLDS 
NEWS»JTEST IS COMPARED TO 2ER0 
NEWS IS COMPARED TO ZERO 

2 PICKUP NEWS 
FIN. -2 IF POSITIVE - ALL OONE 
REV REVERSE SIGN - GO TO REV 
/FFFF CONSTANT OF MINUS ONE 



II 



U 



LI 



II 



ft-* 
16 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
3393 0004 



US UA NSIGN 



CSP17OO0 

CSP17010 

CSP17020 

CSP17030 

CSP17040 

CSP17050 

CSP17060 

CSP17070 

CSP17080 

CSP17090 

CSP17100 

CSP17110 

CSP17120 

CSP17130 

CSP17140 

CSP17150 

CSP17160 

CSP17170 

CSP17180 

CSP17190 

CSP17200 

CSP17210 

CSP17220 

CSP17230 

CSP17240 

CSP17250 

CSP17260 

CSP17270 

CSP17280 

CSP17290 

CSP17300 

CSP17310 

CSP17320 

CSP17330 

CSP17340 

CSP17350 

CSP17360 

CSP17370 

CSP17380 

CSP17390 

CSP17400 

CSP17410 

CSP17420 

CSP17430 

CSP17440 

CSP17450 

CSP17460 

CSP17470 

CSP17480 



CSP17490 
CSP1750O 



ADD 
A1A3 
A1DEC 
A3A1 
CARRY 
DECA1 
DIV 
DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICO MP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



-177- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 

** NZONE SUBROUTINE 

• NAME NZONE 

• LIST 

0000 15A56545 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



I ID) 

(101 



0000 


0000 


NZONE 


DC 


0001 


692! 




5TX 


0002 01 


65800000 




LDX 


0004 


C100 




LD 


0005 00 


95800001 


ONE 


S 


0007 


80FE 




A 


oooe o 


D01A 




STO 


0009 


0001 




STO 


0O0A 00 


C4000000 


L01 


LD 


oooc o 


D0FE 




STO 


0000 01 


4C10003A 




B5C 


00 OF 


901B 




S 


0010 01 


4C18002E 




BSC 



0012 





C0F8 




LD 




0013 





E019 




AND 




0014 





180C 




SRA 




0015 





80F0 




A 




0016 


00 


D5800003 




STO 


11 


0016 


00 


C5800002 




LD 


11 


001A 





9011 




S 




001B 


01 


4C300024 




BSC 


L 


0010 





800E 




A 




001E 


00 


95800003 




S 


11 


0020 





100C 




SLA 




0021 





80E9 




A 




0022 


00 


P4000000 


STO 


STO 


L 


0024 





7104 


FINIS 


MDX 


1 


0025 





6903 




STX 


1 


0026 


00 


65000000 


SAVE1 


LDX 


LI 


0.020 


00 


4C000000 


DON El 


BSC 


L 


002A 





6040 


MINUS 


DC 




002B 





F040 


ZERO 


DC 




002C 





0004 


FOUR 


DC 




0020 





3000 


H300O 


DC 




002E 


00 


C5800002 


TWO 


LD 


11 


0030 





90FE 




S 





NZONE NZONE SUBROUTINE ENTRY POINT 
CALL NZONEUCARO.J.NEWZ. NOLDZ) 
THE ZONE OF THE CHARACTER AT 
JCARO(J) IS TESTED AND NOLDZ IS 
SET. THE ZONE IS MODIFIED AS 
INDICATED BY NEWZ. 
• -• AR6UMENT AODRESS COMES IN HERE 
1 SAVEl+l SAVE IR1 
II NZONE PUT ARGUMENT ADDRESS IN IR1 

1 GET JCARD ADDRESS 
11 1 SUBTRACT J VALUE 

ONE+1 ADO CONSTANT OF ONE 
STO+1 CREATE JCARDU) ADDRESS 
LD1+1 CREATE JCARDU) ADDRESS 
JTEST-JCARDIJ) 
L «-» PICKUP THE CHARACTER 
LD1+1 SAVE IT TEMPORARILY 
IS JTEST NEGATIVE 
L PLUSi- IF NOT NEGATIVE-GO TO PLUS 

ZERO NEGATIVE-CHECK TO SEE IF IT IS 
L TW0.+- AN EBCDIC ZERO-YES-GO TO TWO 
NOLDZ-5+IJTEST-4096 1/4096 
SHIFT 12 IS EQUIVALENT TO DIVIDE 
BY 4096 

AND 3000 IS EQUIVALENT TO 
SUBTRACT 4096 AND SHIFT 
LD1 + 1 NO-RELOAD JTEST 
H3000 REMOVE ALL BUT BITS 2 AND 3 
12 PUT IN LOW ORDER OF ACCUMULATOR 
ONE+1 ADD CONSTANT OF ONE 
3 STORE IN NOLDZ 

IS NEWZ LESS THAN FIVE 

2 PICKUP VALUE OF NEWZ 
FOUR AND CHECK FOR LESS THAN FIVE 
FINISi-Z NO-GO TO EXIT 
FOUR YES - RESTORE NEWZ 

JCARD ( J ) -JTEST +4096* I NEWZ-NOLDZ ) 

3 SUBTRACT NOLDZ 
12 PUT RESULT IN BITS 2 AND 3 
LD1+1 ADD ORIGINAL CHARACTER 
• -« STORE BACK IN JCARDU) 

EXIT... 

4 MOVE OVER FOUR ARGUMENTS 
DONE 1+1 CREATE RETURN ADDRESS 
•-* RESTORE IR1 
*-• RETURN TO CALLING PROGRAM 
/6040 CONSTANT OF EBCDIC MINUS SIGN 
/F040 CONSTANT OF EBCDIC ZERO 
4 CONSTANT OF FOUR 
/3000 CONSTANT FOR STRIPING BITS 

IS NEWZ TWO 
2 PICKUP VALUE OF NEWZ 
TWO+1 IS IT TWO 



0031 01 4C200036 



0033 

0034 01 


C0F6 
D4800023 




LD 
STO 


0036 

0037 00 
0039 


C0F5 

D5800003 

70EA 


NOT 


LD 

STO 
MDX 


003A 
003B 01 


90EF 
4C200049 


PLUS 


S 

esc 


003D 
003E 00 


C0F1 

D58O00O3 




LD 
STO 


0040 00 

0042 

0043 01 


C5900002 

90E9 

4C200024 




LD 

s 

BSC 


0045 

0046 01 

0048 

0049 
004A 00 
004C 
004E 


C0E5 

D4800023 

70DB 

COFE 

D5800003 

70D7 


BIG 
SPEC 


LD 

STO 

MDX 

LD 

STO 

MDX 

END 



CSP17510 

CSP1T520 

CSP17530 

CSP17540 

CSP17550 

CSP17560 

CSP17570 

CSP17580 

CSP17590 

CSP17600 

CSP17610 

CSP17620 

CSP17630 

CSP17640 

CSP17650 

CSP17660 

CSP17670 

CSP17680 

CSP17690 

CSP17700 

CSP17710 

CSP17720 

CSP17730 

CSP17740 

CSP17750 

CSP17760 

CSP17770 

CSP17780 

CSP17790 

CSP17800 

CSP17810 

CSP17820 

CSP17830 

CSP17940 

CSP17850 

CSP17860 

CSP17870 

CSP17880 

CSP17890 

CSP17900 

CSP17910 

CSP17920 

CSP17930 

CSP17940 

CSP17950 

CSP17960 

CSP17970 

CSP17980 

CSP17990 

CSP1S000 

CSP18010 

CSP1S020 

CSP1B030 

CSP18040 

cspieoso 

CSP18060 
CSP18070 



L NOT.Z NO - GO TO NOT 
JCARDU) -24640 
MINUS YES - SET JCARDU) 

I STO+1 EQUAL TO AN EBCDIC MINUS SIGN 

NOLDZ-4 
FOUR SET NOLDZ 

II 3 EQUAL TO FOUR 
FINIS GO TO EXIT 

IS JTEST AN EBCDIC MINUS SIGN 
MINUS NOT NEGATIVE - CHECK FOR EBCDIC 
L SPEC.Z MINUS SIGN-NO-GO TO SPEC 
NOLDZ-2 
TWO+1 YE5-L0AD TWO AND STORE 
II 3 IT IN NOLDZ 

IS NEWZ FOUR 
II 2 PICKUP VALUE OF NEWZ AND 

FOUR CHECK FOR VALUE OF FOUR 
L FINIS. Z NO-GO TO FINIS 
JCARD! JI—4032 
ZERO YES-LOAD EBCDIC ZERO AND 

I STO+1 STORE IT AT JCARDU) 
FINIS SO TO EXIT 
BIG SPECIAL CHARACTER-LOAD LARGE 

II 3 NUMBER AND STORE AT NOLDZ 
FINIS ALL DONE - GO TO EXIT 



PAGE 2 

CSP1S080 
CSP18090 
CSP1S100 

cspisno 

CSP18120 
CSP18130 
CSP18140 
CSP18150 
CSP18160 
CSP18170 
CSP181B0 
CSP18190 
CSP18200 
CSP18210 
CSP1S220 
CSP18230 
CSP1S240 
CSP18250 
CSP18260 
CSP18270 
CSP18280 
CSP18290 
CSP18300 
CSP18310 
CSP18320 
CSP18330 



NO ERRORS IN ABOVE ASSEMBLY. 



// OUP 
•STORE 
3397 0006 



WS UA NZONE 



CSP18340 
CSP18350 



-178- 



// A; 


SM 














CSP18360 


«• PRINT AND SKIP 


SUBROUTINES 


FOR 


1130 CSP 


(ID) 


CSP18370 


• NAME 


PRINT 










(ID) 


CSP18380 


» LIST 














CSP18390 


0041 




17649363 




ENT 




PRINT 


SUBROUTINE ENTRY POINT 


CSP18400 








• CALL PRINT 


(JCARD. Jt 


JLAST. NERR3) 


CSP18410 








» PRINT JCARDIJ! THROUOH JCARD 1 JLAST) ON THE 


CSP18420 








* 1132 PRINTER. PUT ERROR PARAMETER IN NERR3. 


CSP18430 


0069 




224895C0 




ENT 




SKIP 


SUBROUTINE ENTRY POINT 


CSP18440 








» CALL SKIP(N) 




CSP18450 








• EXECUTE 


CONTROL FUNCTION SPECIFIED BY INTEGER N 


CSP18460 


0000 





0001 


ONE 


DC 




1 


CONSTANT OF 1 


CSP1B470 


0001 





2000 


SPACE 


DC 




/2000 


PRINT FUNCTION WITH SPACE 


CSP18480 


0002 





0000 


JCARD 


DC 




«-# 


JCARD J ADDRESS 


CSP18490 


0003 





0000 


JLAST 


DC 




tt-tt 


JCARD JLAST ADDRESS 


CSP185O0 


0001 




003D 


AREA 


BSS 




61 


WORD COUNT 6 PRINT AREA 


CSP18510 


00*1 





0000 


PRINT 


DC 




*-# 


ADDRESS OF 1ST ARGUMENT 


CSP18520 


0042 


20 


176538F1 


TEST 


LIBF 




PRNT1 


CALL BUSY TEST ROUTINE 


CSP18930 


0043 





0000 




DC 




/OOOO 


BUSY TEST PARAMETER 


CSP18540 


0044 





70 FD 




MDX 




TEST 


REPEAT TEST IF BUSY 


CSP18550 


0043 





691A 




STX 


1 


SAVE161 


STORE IR1 


CSP1S560 


0046 


01 


65800041 




LDX 


11 


PRINT 


LOAD 1ST ARGUMENT ADDRESS 


CSP18S70 


0048 


20 


01647880 




LIBF 




ARGS 


CALL ARGS ROUTINE 


CSP18960 


0049 


1 


0002 




DC 




JCARD 


JCARD J PICKED UP 


CSP18390 


004A 


1 


0003 




DC 




JLAST 


JCARD JLAST PICKED UP 


CSP18600 


0049 


1 


0004 




DC 




AREA 


CHARACTER COUNT PICKED UP 


CSP18610 


004C 





0078 




DC 




120 


MAX CHARACTER COUNT 


CSP18620 


0040 





C0B6 




LD 




AREA 


GET CHARACTER COUNT 


CSP18630 


004E 





80B1 




A 




ONE 


HALF ADJUST 


CSP18640 


004F 





1801 




SRA 




1 


DIVIDE BY TWO 


CSP18650 


0050 





D0B3 




STO 




AREA 


STORE WORD COUNT 


CSP1S660 


0051 





C103 




LO 


1 


3 


GET ERROR WORD ADDRESS 


CSP18670 


0052 





D012 




STO 




ERR61 


STORE IT IN ERROR ROUTINE 


CSP18680 


0053 


20 


195C10D2 




LIBF 




RPACK 


CALL REVERSE PACK ROUTINE 


CSP18690 


0054 


1 


0002 




DC 




JCARD 


JCARD J ADDRESS 


CSP18700 


0035 


1 


0003 




DC 




JLAST 


JCARD JLAST ADDRESS 


CSP18710 


0036 


1 


0005 




DC 




AREAS1 


PACK INTO I/O AREA 


CSP18720 


0057 


20 


176558F1 




LIBF 




PRNT1 


CALL PRINT ROUTINE 


CSP18730 


0058 





2000 


WRITE 


DC 




/2000 


PRINT PARAMETER 


CSP18740 


0059 


1 


0004 




DC 




AREA 


I/O AREA BUFFER 


CSP18750 


005A 


1 


0063 




DC 




ERROR 


ERROR PARAMETER 


CSP18760 


005B 





COAS 




LD 




SPACE 


LOAD PRINT WITH SPACE 


CSP18770 


005C 





DOFB 




STO 




WRITE 


STORE IN PRINT PARAMETER 


CSP18780 


0050 





7104 




MDX 


1 


4 


INCREMENT OVER 4 ARGUMENTS 


CSP18790 


005E 





6903 




STX 


1 


D0NE161 


STORE IR1 


CSP1S800 


005F 


00 


65000000 


SAVE1 


LDX 


LI 


#-# 


Reload or restore iri 


CSP18810 


0061 


00 


4C000000 


00NE1 


BSC 


L 


#-# 


RETURN TO CALLING PROGRAM 


CSP18820 


0063 





0000 


ERROR 


DC 




«-« 


RETURN ADDRESS GOES HERE 


C5P18830 


0064 


00 


D4OO000O 


ERR 


STO 


L 


#-» 


STORE ACC IN ERROR PARAM 


CSP18840 


0066 





1810 




SRA 




16 


CLEAR ACC 


CSP18850 


0067 


01 


4C800063 




BSC 


I 


ERROR 


RETURN TO PRNT1 PROGRAM 


CSP18860 


0069 





0000 


SKIP 


DC 




#-* 


ADDRESS OF ARGUMENT ADDR 


CSP18870 


006A 


01 


C4800069 




LD 


I 


SKIP 


GET ARGUMENT ADDRESS 


CSP18880 


006C 





D001 




STO 




ARGC1 


DROP IT AND 


CSP18890 


006D 


00 


C4000000 


ARO 


LD 


L 


#-# 


GET ARGUMENT 


CSP18900 


006F 


01 


4C300074 




BSC 


L 


NOSUPi-2 


GO TO NOSUPPRESSION IF 6 


CSP18910 


0071 





C009 




LD 




NOSPC 


SET UP SPACE SUPPRESSION 


CSP18920 



0072 


DOES 




STO 


WRITE 


0073 


7003 




MDX 


DONE 


0074 


D001 


NOSUP 


STO 


CNTRL 


0075 20 


176558F1 




LIBF 


PRNT1 


00 76 


3000 


CNTRL 


DC 


/3000 


0077 01 


74010069 


DONE 


MDX L 


SKIP.l 


0079 01 


4C800069 




BSC I 


SKIP 


007B 


2010 


NOSPC 


DC 


/2010 


007C 






END 





CHANGE PRINT FUNCTION 
GO TO RETURN 
SET UP COMMAND 
CALL THE PRNT ROUTINE 
CARRIAGE COMMAND WORD 
ADJUST RETURN ADDRESS 
RETURN TO CALLING PROGRAM 
SUPPRESS SPACE COMMAND 
END OF PRINT SUBPROGRAM 



PAGE 2 

CSP18930 
CSP18940 
CSP18950 
CSP18960 
CSP18970 
CSP189B0 
CSP18990 
CSP19000 
CSP19010 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
339D 0005 



WS UA PRINT 



CSP19020 
CSP19030 



-179- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 

»» PUT SUBROUTINE 

• NAME PUT 

* LIST 

0000 17923000 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 

(IDI 



0000 0000 


PUT 


DC 


0001 6957 




STX 


0002 01 65800000 




LDX 


0004 C100 




LD 


0005 D04E 




STO 


0006 00 95800002 




5 


0008 800E 




A 


0009 0030 




STO 


000A C103 




LD 


oooa o 0014 




STO 


000C 800A 




A 


0000 0041 




STO 


OOOE C104 




LD 


000F 0012 




STO 


0010 00 C5800005 




LD 


0012 D017 




STO 


0013 00 C5B00002 


TWO 


LD 


0015 0024 




STO 


0016 00 95800001 


one. 


S 


001S 80FE 




A 


0019 4808 




BSC 


001A COFC 




LD 


0019 D017 




STO 


001C 7106 




MDX 


001D 6930 




STX 


001E 30 05042880 




CALL 


0020 0000 


VAR 


DC 


0021 20 05044100 




LIBF 


0022 0000 


ADJST 


DC 


0023 30 262164C5 




CALL 


0025 F040 


ZERO 


DC 


0026 C003 




LD 


0027 01 4C080032 




8SC 


0029 00 65000000 


ADRN2 


LDX 


002B 20 05517A00 


AGAIN 


LIBF 


002C 1 005C 




DC 


0020 30 262164CJ 




CALL 


002F 0000 




DC 



PUT PUT SUBROUTINE ENTRY POINT 

CALL PUT ( JCARD. J> JLAST. VAR. ADJST. N I 
THE REAL NUMBER VAR IS HALF- 
ADJUSTEO WITH ADJST AND 
TRUNCATED. THEN DIOITS ARE 
CONVERTED FROM REAL TO EBCDIC 
AND PLACED IN THE JCARD FIELD 
FROM JCARD (JLAST) TO JCARDIJI. 
»-* ARGUMENT ADDRESS COMES IN HERE 
1 FIN+1 SAVE IR1 
II PUT PUT ARGUMENT ADDRESS IN IR1 
1 SET JCARD ADDRESS 

JCROl SAVE FOR NZONE SUBROUTINE 
II 2 SUBTRACT JLAST VALUE 
ONE-M ADD CONSTANT OF ONE 
PUT1+1 CREATE JCARDIJLAST) ADDRESS 

13 GET VAR ADDRESS 
VAR SAVE FOR PICKUP 
ONE+1 ADD CONSTANT OF ONE 
SIGN+1 SAVE SIGN POSITION ADDRESS 

14 GET ADJST ADORESS 
■ ADJST AND SAVE 

II 5 GET N VALUE AND 

ADRN2+1 SAVE FOR TRUNCATION 
II 2 GET JLAST VALUE AND 

JLAST SAVE IT AT JLAST 
II 1 SUBTRACT J VALUE 

ONE+1 ADD CONSTANT OF ONE 
* CHECK FIELD WIDTH 

ONE*l NEGATIVE OR ZERO-MAKE IT ONE 
PUTCT+1 OK-SAVE FIELD WIDTH 
1 6 MOVE OVER SIX ARGUMENTS 
1 DONEK-1 CREATE RETURN ADDRESS 

D IGS'WHOLE I ABS( VAR I +A0JST I 
EABS TAKE THE ABSOLUTE VALUE 
*-• OF VAR 
EADO ADD TO IT THE 
»-« HALF-ADJUSTMENT VALUE 
WHOLE TRUNCATE ANY FRACTION 
/F040 CONSTANT OF EBCDIC ZERO 

IS N GREATER THAN ZERO 
ADRN2+1 CHECK TO SEE IF N IS GREATER 
L PUTCT.+ THAN ZERO-NO-GO TO PUTCT 

JNOW-1 
LI »-» YES-PUT VALUE OF N IN IR1 
EMPY MULTIPLY BY 
PNT1 ONE TENTH 
WHOLE TRUNCATE THE FRACTION 
DUMMY 

SEE IF JNOW IS LESS THAN N. 
IF YESi JNOW-JNOW+1 ANO GO BACK 
FOR MORE. IF NO. START 
CONVERTING. 



CSP19040 
CSP19050 
CSP19060 
CSP19070 
C5P19080 
CSP19090 
CSP19100 
CSP19110 
CSP19120 
CSP19130 
CSP19140 
CSP19150 
CSP19160 
CSP19170 
CSP19180 
CSP19190 
CSP19200 
CSP19210 
CSP19220 
CSP19230 
CSP19240 
CSP192S0 
CSP19260 
CSP19270 
CSP19280 
CSP19290 
CSP19300 
CSP19310 
CSP19320 
CSP19330 
CSP19340 
CSP19350 
CSP19360 
CSP19370 
CSP19380 
CSP19390 
CSP 19*00 
CSP19410 
CSP19420 
CSP19430 
CSP19440 
CSP19450 
CSP19460 
CSP19470 
CSP19480 
CSP19490 
CSP19500 
CSP19510 
CSP19520 
CSP19530 
CSP19S40 
CSP19550 
CSP19560 
CSP19570 
CSP19580 
CSP19590 
CSP19600 
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0030 


71FF 




MDX 


1 


0031 


70F9 




MUX 




0032 00 


69000000 


PUTCT 


LDX 


LI 


0034 20 


038A3980 


BACK 


LIBF 




0039 1 


0062 




DC 




0036 20 


05517A00 




LIBF 




0037 1 


005C 




DC 




003S 30 


262164C5 




CALL 




003A 


0000 


JLAST 


DC 




003B 20 


058A35eO 




LIBF 




00 3C 1 


0065 




DC 





0030 20 
00 3E 1 
003F 20 

0040 20 

0041 20 

0042 1 

0043 20 

0044 
0049 
0046 00 

0048 20 

0049 1 



09517A00 

009F 

19399900 

22999000 

09044100 

0062 

091B99CO 

100S 

E8DF 

D4000000 

094C4000 

0069 



004A 01 74010047 
004C 71FF 
004D 70E6 

004E 00 C4000000 
0090 01 4C100058 
0092 30 13A9634S 
0054 OOOO 
0059 1 003A 
0096 1 0014 

0057 1 0094 

0058 00 65000000 
005A 00 4C0000O0 
005C 7D 66666666 
005F 84 50000000 
0062 0003 
0065 0003 
0068 



FIN 

D0NE1 

PNT1 

ETEN 

DISS 

DIGS1 



LIBF 
DC 

LIBF 

LIBF 

LIBF 

DC 

LIBF 

SLA 

OR 

STO L 

LIBF 

DC 



MDX L 
MDX 1 
MDX 

LD L 
BSC L 
CALL 

DC 
DC 
DC 
DC 

LDX LI 

BSC L 

XFLC 

XFLC 

BSS 

BSS 

END 



-1 DECREMENT N BY ONE 

AGAIN NOT DONE-SO BACK FOR MORE 

JNOW-JLAST 
»-* DONE-PUT FIELD WIDTH IN IR1 
ESTO STORE FAC 
DISS IN DICS 

DI6T« WHOLE (DIGS/ 10. 01 
EMPY MULTIPLY BY 
PNT1 ONE TENTH AND 
WHOLE TRUNCATE ANY FRACTION 
•-« JLAST VALUE 
ESTO STORE RESULT IN 
DIGS1 DIGS1-SAME AS DIGT 

JCARD I JNOW ) "256* I F I X ( D I GS 

- 10.0»DIGTI-4032 

MULTIPLY BY 256 IS SAME AS SHIFT 

EIGHT 

SUBTRACT 4032 IS SAME AS OR F040 
EMPY MULTIPLY DIGT BY 
ETEN TEN AND 

NORM NORMALIZE THE RESULT 
SNR REVERSE THE SIGN 
EADD AND ADD IN THE 
DIGS VALUE OF DIGS 
IFIX FIX THE RESULT 
8 AND PLACE IN BITS 4-7 
ZERO MAKE AN Al CHARACTER 
*-* AND STORE IN JCARDIJNOWI 
ELD SET FAC EOUAL 
DIGS1 TO DIGS1 

SEE IF JNOW IS GREATER THAN J. 

IF YES. JNOW-JNOW-1 AND GO BACK 

FOR MORE. IF NO. SET ZONE. 
PUT1+1.1 CHANGE JCARD ADDRESS 
-1 DECREMENT COUNT 
BACK NOT DONE-GO BACK FOR MORE 

IS VAR LESS THAN ZERO 
#-* DONE-PICKUP ORIGINAL SIGN 
FIN.- IF NOT NEG-ALL DONE-GO TO EXIT 
NZONE CALL NZONE FOR ZONE SETTING 
*-* ADDRESS OF JCARD 
JLAST ADDRESS OP JLAST 
TWO+1 ADDRESS OF NEW ZONE INDICATOR 
JCRD1 DUMMY 

EXIT 

«-• RESTORE IR1 

•-• RETURN TO CALLING PROGRAM 

0.1 CONSTANT OF ONE TENTH 

10.0 CONSTANT OF TEN POINT ZERO 

3 TEMPORARY AREA FOR GETTING A OGT 

3 TEMPORARY AREA FOR GETTING A DGT 
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CSP19610 
CSP19620 
CSP19630 
CSP19640 
CSP19630 
CSP19660 
CSP19670 
CSP19680 
CSP19690 
CSP19700 
CSP19710 
CSP19720 
CSP19730 
CSP19740 
CSP19750 
CSP19760 
CSP19770 
CSP19780 
CSP19790 
CSP19B00 
CSP19810 
CSP198Z0 
CSP19830 
CSP19840 
CSP19850 
CSP19860 
CSP19870 
CSP19S80 
CSP19890 
CSP19900 
CSP19910 
CSP19920 
CSP19930 
CSP19940 
CSP19950 
CSP19960 
CSP19970 
CSP19980 
CSP19990 
CSP20000 
CSP20010 
CSP20020 
CSP20030 
CSP20040 
CSP20030 
CSP20060 
CSP20070 
CSP20080 
CSP2009O 
CSP20100 
CSP20110 
CSP20120 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 

•STORE WS UA PUT 

33A2 0007 



CSP20130 
CSP20140 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442" 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 

«» PRINT AND SKIP 

» NAME P1403 

» LIST 

00*1 1TC74C33 



SUBROUTINES FOR 1130 CSPt 1103 



ENT P1403 SUBROUTINE ENTRY POINT 
CALL P1403 [JCARD. Jt JLAST. NERR3) 
PRINT JCARDIJI THROUGH JCAROIJLASTI ON THE 
1403 PRINTER. PUT ERROR PARAMETER IN NERR3. 

ENT S1403 SUBROUTINE ENTRY POINT 
CALL S1403INI „ 

EXECUTE CONTROL FUNCTION SPECIFIED BY INTEGER N 



0001 
2000 
0000 
0000 
003D 
0000 
6926 
0043 01 65800041 

0045 20 01647860 

0046 1 0002 

0047 1 



0000 
0001 
0002 
0003 
0004 
0041 
0042 



0048 
0049 
004A 
004B 
004C 
004D 
004E 
004F 
0050 
0051 



0003 
0004 
0078 
C0B9 
80B4 
1801 
00B6 
1001 
DOOA 
C103 
D01C 

0052 20 195C1002 

0053 1 0002 

0054 1 0003 

0055 1 0005 

0056 20 292570D6 

0057 0000 

0058 1 0005 

0059 1 0005 
005A 0000 

0059 30 050978F3 
0050 20 176558F3 
005E 0000 
005F 70FD 

0060 20 176558F3 

0061 2000 



0004 

006C 

C09C 

DOFB 

7104 

6903 

0068 00 65000000 
006A 00 4COOOO00 
006C 0000 
006D 00 D4000000 



0062 
0063 
0064 
0065 
0066 
0067 



ONE DC 

SPACE DC 

JCARD DC 

JLAST DC 

AREA BSS 

P1403 DC 
STX 
LDX 
LIBF 
DC 
DC 
OC 
DC 
LD 
A 

SRA 
STO 
SLA 
STO 
LD 
STO 
LIBF 
DC 
DC 
DC 

LIBF 
DC 
DC 
DC 
DC 

CALL 
LIBF 
DC 
MDX 
LIBF 
WRITE DC 
DC 
DC 
LD 
STO 
MDX 
STX 
SAVEl LDX 
D0NE1 BSC 
ERROR DC 
ERR STO 



1 
/2000 



CNT 
TEST 



61 
«-« 

1 SAVE161 

1 P1403 
ARGS 
JCARD 
JLAST 
AREA 
120 
AREA 
ONE 
1 

AREA 
1 
CNT 

1 3 
ERRS1 
RPACK 
JCARD 
JLAST 
ARE Ail 
ZIPCO 
/0000 
AREA+1 
AREA+1 
»-* 
EBPT3 
PRNT3 
/0000 
TEST 
PRNT3 
/2O00 
AREA 
ERROR 
SPACE 
WRITE 
1 4 
1 D0NE161 

LI »-* 

L «-* 



006F 


1810 




SRA 


16 


0070 01 


4C80006C 




BSC I 


ERROR 


0072 


0000 


S1403 


DC 


*-# 


0073 01 


C4800072 




LD I 


S1403 


0075 


0001 




STO 


ARG&l 


0076 00 


C4000000 


ARG 


LD L 


#— * 


007B 01 


4C30007D 




BSC L 


NOSUP 1-2. 


0O7A 


C009 




LD 


NOSPC 


0O7B 


DOE5 




STO 


WRITE 


O07C 


7003 




MDX 


DONE 


007D 


D001 


NOSUP 


STO 


CNTRL 


007E 20 


176558F3 




LIBF 


PRNT3 


007F 


3000 


CNTRL 


DC 


/3000 


0080 01 


74010072 


DONE 


MDX L 


S1403.1 


0082 01 


4C800072 




esc i 


S1403 


0084 


2010 


NOSPC 


DC 


/2010 


0086 






END 





CONSTANT OF 1 
PRINT FUNCTION WITH SPACE 
JCARD J AODRESS 
JCARD JLAST ADDRESS 
WORD COUNT & PRINT AREA 
ADDRESS OF 1ST ARGUMENT 
STORE IR1 

LOAD 1ST ARGUMENT ADDRESS 
CALL ARGS ROUTINE 
JCARD J PICKED UP 
JCARD JLAST PICKED UP 
CHARACTER COUNT PICKED UP 
MAX CHARACTER COUNT 
GET CHARACTER COUNT 
HALF ADJUST 
DIVIDE BY TWO 
STORE WORD COUNT 
DOUBLE IT " CHARACTER 
COUNT AND STORE COUNT 
GET ERROR WORD ADDRESS 
STORE IT IN ERROR ROUTINE 
CALL REVERSE PACK ROUTINE 
JCARD J ADDRESS 
JCARD JLAST ADDRESS 
PACK INTO I/O AREA 
CALL CONVERSION ROUTINE 
FROM EBCDIC TO 1403 CODES 
FROM I/O AREA 
TO I/O AREA 
CHARACTER COUNT 



CSP2015O 
(IDI CSP20160 
(IDI CSP20170 
CSP20180 
CSP2019O 
CSP20200 
CSP2021O 
CSP20220 
CSP2O230 
CSP20240 
CSP20250 
CSP20260 
CSP20270 
CSP20260 
CSP20290 
CSP20300 
CSP20310 
CSP20320 
CSP20330 
CSP20340 
CSP20350 
CSP20360 
CSP20370 
CSP20380 
CSP20390 
CSP20400 
CSP20410 
CSP20420 
CSP20430 
CSP20440 
CSP20450 
CSP20460 
CSP20470 
CSP20480 
CSP20490 
CSP20500 
CSP20S10 
CSP20520 
CSP20530 
CSP20540 
CSP205S0 



CONVERSION TABLE FOR ZIPCO CSP20360 

CALL BUSY TEST ROUTINE CSP20570 

BUSY TEST PARAMETER CSP20580 

REPEAT TEST IF BUSY CSP2059O 

CALL PRINT ROUTINE CSP20600 

PRINT PARAMETER CSP2061O 

I/O AREA BUFFER C5P20620 

ERROR PARAMETER CSP20630 

LOAD PRINT WITH SPACE CSP20640 

STORE IN PRINT PARAMETER CSP20650 



INCREMENT OVER 

STORE IR1 

RELOAD OR RESTORE IR1 

RETURN TO CALLING PROGRAM 

RETURN ADDRESS GOES HERE 

STORE ACC IN ERROR PARAM 



ARGUMENTS CSP20660 
CSP20670 



CSP20680 
CSP20690 
CSP20700 
CSP20710 



CLEAR ACC 

RETURN TO PRNT3 PROGRAM 

ADDRESS OF ARGUMENT ADDR 

GET ARGUMENT ADDRESS 

DROP IT AND 

GET ARGUMENT 

GO TO NOSUPPRESSION IF & 

SET UP SPACE SUPPRESSION 

CHANGE PRINT FUNCTION 

GO TO RETURN 

SET UP COMMANO 

CALL THE PRNT3 ROUTINE 

CARRIAGE COMMAND WORD 

ADJUST RETURN ADDRESS 

RETURN TO CALLING PROGRAM 

SUPPRESS SPACE COMMAND 

END OF P1403 SUBPROGRAM 
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CSP20720 
CSP20730 
CSP20740 
CSP20750 
CSP20760 
CSP20770 
CSP20780 
CSP20790 
CSP20800 
CSP20810 
CSP20820 
CSP20830 
CSP20840 
CSP20850 
CSP20860 
CSP20670 
CSP20880 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
33A9 0006 



WS UA P1403 



CSP20890 
CSP20900 
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// ASM 












CSP20910 


»• PUNCH SUBROUTINE 


FOR 1130 es^. 


1442-5 


{ ID) 


CSP20920 


» NAME P1442 








1 ID) 


CSP20930 


» LIST 












CSP20940 


0053 




17C74D32 




ENT 


P1442 


SUBROUTINE ENTRY POINT 


CSP20950 








• CALL P1442 


(JCARD. J 


> JLAST. NERR2I 


CSP20960 








« PUNCH JCARDIJI THROUGH JCARDULASTI INTO THE 


CSP20970 








* BEGINNING OF A CARD. 


PUT ERROR PARAMETER INTO 


CSP20980 








* NFRR2. 






CSP20990 


0000 





0000 


JCARO 


DC 


*-* 


JCARD J ADDRESS 


CSP21000 


0001 




0051 


ARE 1 * 


BSS 


81 


I/O AREA BUFFER 


CSP21010 


0052 





0000 


FLAO 


DC 


#-# 


ERROR INDICATOR 


CSP21020 


0053 





0000 


P1442 


DC 


#-* 


FIRST ARGUMENT ADDRESS 


CSP21030 


005* 





6922 




STX 1 


SAVE161 


SAVE IR1 


CSP21040 


0055 


01 


65800053 




LDX 11 


PI 442 


LOAD 1ST ARGUMENT ADDRESS 


CSP21050 


0057 


20 


01647880 




LIBF 


ARGS 


CALL ARGS SUBPROGRAM 


CSP21060 


005S 


1 


0000 




DC 


JCARD 


GET JCARDIJI ADDRESS 


CSP21070 


0059 


1 


0067 




DC 


JLAS2 


GET JCARD(JLAST) ADDRESS 


CSP21080 


005A 


1 


0001 




DC 


AREA 


GET CHARACTER COUNT 


CSP21090 


005B 





0050 




DC 


80 


MAX CHARACTER COUNT 


CSP21100 


005C 





C0A4 




LD 


AREA 


DISTRIBUTE COUNT 


CSP21110 


00 50 





DOOB 




STO 


CNT2 


INTO CNT2 


CSP2U20 


005E 





C103 




LD 1 


3 


GET ERROR WORD ADDRESS 


CSP21130 


005F 





D01C 




STO 


ERR+1 


STORE INSIDE ERROR ROUTINE 


CSP21140 


0060 





1810 




SRA 


16 


CLEAR ACC 


CSP21150 


0061 





DOFO 




5 TO 


FLA6 


CLEAR ERROR INDICATOR 


CSP21160 


0062 


20 


22989547 




LIBF 


SUING 


CALL REVERSE ARRAY 


CSP21170 


0063 


1 


0000 




DC 


JCARD 


FROM JCARD J 


CSP21180 


0064 


1 


0067 




DC 


JLAS2 


TO JCARD JLAST 


CSP21190 


0065 


20 


225C5144 




LIBF 


SPEED 


CALL CONVERSION ROUTINE 


CSP21200 


0066 





0011 




DC 


/0011 


FROM EBCDIC TO CARD CODE 


CSP21210 


0067 





0000 


JLAS2 


DC 


*-# 


FROM JCARD JLAST 


CSP21220 


0068 


1 


0002 




DC 


AREAfrl 


TO THE I/O AREA BUFFER 


CSP21230 


0069 





0000 


CNT2 


DC 


*-# 


CHARACTER COUNT 


CSP21240 


006A 


20 


17543231 




LIBF 


PNCH1 


CALL PUNCH ROUTINE 


CSP21250 


006B 





2000 




DC 


/2000 


PUNCH 


CSP21260 


006C 


1 


0001 




DC 


AREA 


I/O AREA BUFFER 


CSP21270 


006D 


1 


007A 




DC 


ERROR 


ERROR PARAMETER 


CSP212S0 


006E 


20 


22989547 




LIBF 


SWING 


REVERSE THE ARRAY 


CSP21290 


006F 


1 


0000 




DC 


JCARD 


FROM JCARDIJI 


CSP21300 


0070 


1 


0067 




DC 


JLAS2 


TOJCARDIJLASTI 


CSP21310 


0071 


20 


17543231 


TEST 


LIBF 


PNCH1 


CALL BUSY TEST ROUTINE 


CSP21320 


0072 





0000 




DC 


/OOOO 


BUSY TEST PARAMETER 


CSP21330 


0073 





70FD 




MDX 


TEST 


REPEAT IF BUSY 


CSP21340 


0074 





710* 




MDX 1 


4 


INCREMENT 4 ARGUMENTS 


CSP21350 


0075 





6903 




STX 1 


DONE+1 


STORE IR1 


CSP21360 


0076 


00 


65OOO000 


SAVE! 


LDX LI 


»-# 


RESTORE IR1 


CSP21370 


0078 


00 


4C00O000 


DONE 


BSC L 


»-» 


RETURN TO CALLING PROGRAM 


CSP21380 


007A 





0000 


ERROR 


OC 


»-# 


START OF ERROR ROUTINE 


CSP21390 


00 7B 


00 


D4000000 


ERR 


STO L 


#-# 


STORE ACC IN ERROR WORD 


CSP21400 


007D 


01 


74010052 




MDX L 


FLAG.l 


SET THE FLAG INDICATOR 


CSP21410 


007F 


01 


4CB0007A 




BSC I 


ERROR 


RETURN TO INTERRUPT PROGRN 


1 CSP21420 


0082 








END 




END OF P1442 SUBPROGRAM 


CSP21430 



NO ERRORS IN ABOVE ASSEMBLY. 



// OUP 
•STORE 
33AF 0004 



WS UA P1442 



CSP21440 
CSP21450 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1443 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICO MP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 














CSP21460 


»• READ 


AND PUNCH 


SUBROUTINES FOR 


1130 CSP 


(IDI 


CSP21470 


« NAME I 


*EAD 










(ID) 


CSP21480 


• LIST 














CSP21490 


0093 




19141100 




ENT 




READ 


SUBROUTINE ENTRY POINT 


CSP21900 








» CALL READ IJCARDt J. 


JLAST. NERR1) 


CSP21910 








• READ COLUMNS FROM BEGINNING OF CARD INTO JCARDU) 


CSP21920 








» THROUGH JCARDIJLAST). PUT ERROR PARAMETER IN 


CSP21530 








* NERR1. 








CSP21540 


ooac 




179150C8 




ENT 




PUNCH 


SUBROUTINE ENTRY POINT 


CSP21990 








» CALL PUNCH 


(JCARD. J 


i JLAST. NERR2I 


CSP21560 








ft PUNCH JCARDIJI THROUGH JCAROIJLASTI INTO THE 


CSP21970 








• BEGINNING OF A CARD. 


PUT ERROR PARAMETER INTO 


CSP21960 








• NERR2. 








CSP21590 


0000 





0000 


JCARD 


DC 




*-* 


JCARD J ADDRESS 


CSP21600 


0001 




0051 


AREA 


BSS 




81 


I/O AREA BUFFER 


CSP21610 


0092 





0000 


FLAG 


DC 




*-• 


ERROR INDICATOR 


CSP21620 


0093 





0000 


READ 


DC 




*-# 


FIRST ARGUMENT ADDRESS 


CSP21630 


0094 





691B 




STX 


1 


SAVE It 1 


SAVE IR1 


CSP21640 


0099 


01 


69800093 




LDX 


11 


READ 


GET 1ST ARGUMENT ADDRESS 


CSP21650 


0097 





4022 




BSI 




SETUP 


GO TO SETUP 


CSP21660 


0058 


20 


03059131 




LIBF 




CARD1 


CALL CARD READ ROUTINE 


CSP21670 


0059 





1000 




DC 




/1000 


READ 


CSP21680 


009A 


1 


0001 




DC 




AREA 


AREA PARAMETER 


CSP21690 


oose 


1 


0073 




DC 




ERROR 


ERROR PARAMETER 


CSP21700 


005C 


20 


225CS144 


CONVT 


LIBF 




SPEED 


CALL CONVERSION ROUTINE 


CSP21710 


0090 





0010 




DC 




/0010 


CARD CODE TO EBCDIC 


CSP21720 


005E 


1 


0002 




DC 




AREAS1 


FROM AREA 


CSP21730 


00 9F 





0000 


JLAS1 


DC 




ft-ft 


TO JCARD JLAST 


CSP21740 


0060 





0000 


CNT1 


DC 




*-• 


CHARACTER COUNT 


CSP21750 


0061 





C0F0 




LD 




FLAG 


ERROR INDICATOR 


CSP21760 


0062 


01 


4C160067 




BSC 


L 


FINAL. S- 


ALL DONE IF ZERO 


CSP21770 


0064 





1810 




SRA 




16 


CLEAR ACC 


CSP21780 


0065 





DOEC 




STO 




FLAG 


CLEAR THE INDICATOR 


CSP21790 


0066 





70FS 




MDX 




CONVT 


CONVERT AGAIN 


CSP21800 


0067 


20 


22989347 


FINAL 


LIBF 




SWING 


REVERSE THE ARRAY 


CSP21810 


0068 


1 


0000 




DC 




JCARD 


FROM JCARD J 


CSP21820 


0069 


1 


005F 




DC 




JLAS1 


TO JCARD JLAST 


CSP21630 


006A 


20 


03059131 


TEST 


LIBF 




CARD! 


CALL BUSY TEST ROUTINE 


CSP21840 


006B 





0000 




DC 




/OOOO 


BUSY TEST PARAMETER 


CSP21S90 


006C 





70FD 




MDX 




TEST 


REPEAT IF BUSY 


CSP21S60 


00 6D 





7104 




MDX 


1 


4 


INCREMENT 4 ARGUMENTS 


CSP21S70 


006E 





6903 




STX 


1 


DONE&l 


STORE IR1 


CSP21880 


006F 


00 


65000000 


SAVE1 


LDX 


LI 


»-• 


RESTORE IR1 


CSP21690 


0071 


00 


4COO0O0O 


DONE 


BSC 


L 


ft-ft 


RETURN TO CALLING PROGRAM 


CSP21900 


0073 





0000 


ERROR 


DC 




• -ft 


START OF ERROR ROUTINE 


CSP21910 


007* 


00 


04000000 


ERR 


STO 


L 


• -• 


STORE ACC IN ERROR WORD 


CSP21920 


0076 


01 


74010052 




MDX 


L 


FLAG.l 


SET THE FLAG 1N0ICAT0R 


CSP21930 


0078 


01 


4C800073 




BSC 


I 


ERROR 


RETURN TO INTERRUPT PROGRM 


CSP21940 


00 7A 





oooo 


SETUP 


DC 




»-» 


START OF SETUP ROUTINE 


CSP219S0 


0078 


20 


01647880 




LIBF 




ARGS 


CALL ARGS SUBPROGRAM. 


CSP21960 


007C 


1 


0000 




DC 




JCARD 


GET JCARD J ADDRESS 


CSP21970 


0070 


1 


005F 




DC 




JLASl 


GET JCARD JLAST ADORESS 


CSP219S0 


007E 


1 


0001 




DC 




AREA 


GET CHARACTER COUNT 


CSP21990 


007F 





0050 




DC 




80 


MAX CHARACTER COUNT 


CSP22000 


0080 





CODE 




LD 




JLASl 


DISTRIBUTE JCARD JLAST 


CSP22010 


0081 





0014 




STO 




JLAS2 


INTO JLAS2 


CSP22020 



0082 


01 


C4000001 


LD 


L AREA 


0084 





DODB 


STO 


CNT1 


0085 





D012 


STO 


CNT2 


0086 





C103 


LD 


1 3 


0087 





OOED 


STO 


ERRS1 


0088 





1810 


SRA 


16 


0089 





DOCS 


STO 


FLAG 


00 SA 


01 


4C80007A 


BSC 


I SETUP 


00 SC 





0000 


PUNCH DC 


»-* 


008D 





69E2 


STX 


1 SAVElfrl 


OOSE 


01 


65S0008C 


LOX 


11 PUNCH 


0090 





40E9 


BSI 


SETUP 


0091 


20 


22989547 


LIBF 


SWING 


0092 


1 


0000 


DC 


JCARD 


0093 


1 


005F 


DC 


JLASl 


0094 


20 


225C9144 


LIBF 


SPEED 


0095 





0011 


DC 


/OOll 


0096 





0000 


JLAS2 DC 


•-• 


0097 


1 


0002 


DC 


AREA61 


0098 





0000 


CNT2 DC 


• -• 


0099 


20 


03099131 


LIBF 


CARD1 


009A 





2000 


DC 


/2000 


O09B 


1 


0001 


DC 


AREA 


009C 


1 


0073 


DC 


ERROR 


009D 





70C9 


MDX 


FINAL 


009E 






END 





DISTRIBUTE COUNT 

INTO CNT1 

AND CNT2 

GET ERROR WORD ADORESS 

STORE INSIDE ERROR ROUTINE 

CLEAR ACC 

CLEAR ERROR INDICATOR 

RETURN TO CALLING PROG 

PUNCH ROUTINE STARTS HERE 

SAVE IR1 

LOAD 1ST ARGUMENT ADDRESS 

GO TO SETUP ROUTINE 

CALL REVERSE ARRAY 

FROM JCARD J 

TO JCARD JLAST 

CALL CONVERSION ROUTINE 

FROM EBCDIC TO CARD CODE 

FROM JCARD JLAST 

TO THE 1/0 AREA BUFFER 

CHARACTER COUNT 

CALL PUNCH ROUTINE 

PUNCH 

I/O AREA BUFFER 

ERROR PARAMETER 

ALL THROUGH. GO TO FINAL 

END OF READ SUBPROGRAM 



PAGE 2 

CSP22030 
CSP22040 
CSP22050 
CSP22060 
CSP22070 
CSP22080 
CSP22090 
CSP22100 
CSP22110 
CSP22120 
CSP22130 
CSP22140 
C5P22130 
CSP22160 
CSP22170 
CSP22180 
CSP22190 
CSP2220O 
CSP22210 
CSP22220 
CSP22230 
CSP22240 
CSP22250 
CSP22260 
CSP22270 
CSP22280 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
33B3 0006 



WS UA READ 



CSP22290 
CSP22300 



-184- 



// ASM 














CSP22310 


«• READ 


SUBROUTINE 


FOR 1130 CSP. 


2501 


1 ID) 


CSP22320 


• NAME 


R2501 










1 ID) 


CSP22330 


• LIST 














CSP22340 


0093 


19CB5C31 




ENT 




R2501 


SUBROUTINE ENTRY POINT 


CSP22350 






» CALL R230K JCARD. J. 


JLAST. NERR1I 


CSP22360 






• READ COLUMNS FROM BEGINNING OF CARO INTO JCARD(J) 


CSP22370 






• THROUGH 


JCARD(JLAST) 


• PUT ERROR PARAMETER IN 


CSP22380 






» NERR1. 








CSP22390 


OOOO 


0000 


JCARO 


DC 




#-# 


JCARD J ADDRESS 


CSP22400 


0001 


0051 


AREA 


BSS 




81 


I/O AREA BUFFER 


CSP22410 


0032 


0000 


FLAO 


DC 




*-tf 


ERROR INDICATOR 


CSP22420 


0053 


0000 


R2301 


DC 




#-» 


FIRST ARGUMENT ADDRESS 


CSP22430 


0034 


692C 




STX 


1 


SAVE161 


SAVE IR1 


CSP22440 


0055 01 


63800053 




LDX 


11 


R2501 


GET 1ST ARGUMENT ADDRESS 


CSP22450 


0057 20 


01647660 




LIBF 




ARGS 


CALL ARGS SUBPROGRAM 


CSP22460 


0050 1 


0000 




DC 




JCARD 


GET JCARD J ADDRESS 


CSP22470 


0059 1 


0072 




DC 




JLAS1 


GET JCARD JLAST ADDRESS 


CSP224B0 


005A 1 


0001 




DC 




AREA 


GET CHARACTER COUNT 


CSP22490 


0050 


0050 




DC 




80 


MAX CHARACTER COUNT 


CSP22300 


005C 


C0A4 




LO 




AREA 


DISTRIBUTE COUNT 


CSP22510 


005D 


D015 




STO 




CNT1 


INTO CNT1 


CSP22S20 


0O5E 


C103 




LO 


1 


3 


GET ERROR WORD ADDRESS 


CSP22530 


005F 


0026 




STO 




ERRtl 


STORE INSIDE ERROR ROUTINE 


CSP22540 


0060 


1610 




SRA 




16 


CLEAR ACC 


CSP22550 


0061 


OOFO 




STO 




FLAG 


CLEAR ERROR INDICATOR 


CSP22560 


0062 


7104 




MDX 


1 


4 


INCREMENT 4 ARGUMENTS 


CSP22570 


0063 


691F 




STX 


1 


D0NE61 


STORE IR1 


CSP22S80 


0064 


C026 




LD 




ONE SET 


AREA TO ALL ONES 


CSP22590 


0063 00 


65000090 




LDX 


LI 


60 LOAD IR1 WITH AREA SIZE 


CSP22600 


0067 01 


05000001 


MO 


STO 


LI 


AREA STORE A ONE IN AREA 


CSP22610 


0069 


71FF 




MDX 


1 


-1 GO 


TO NEXT WORD OF AREA 


CSP22620 


006A 


70FC 




MDX 




MO GO I 


SACK UNTIL FINISHED 


CSP22630 


0066 20 


19141131 




LIBF 




REA01 


CALL CARD READ ROUTINE 


CSP22640 


O06C 


1000 




DC 




/1000 


READ 


CSP22650 


006D 1 


0001 




DC 




AREA 


AREA PARAMETER 


CSP22660 


006E 1 


0084 




DC 




ERROR 


ERROR PARAMETER 


CSP22670 


006F 20 


225C5144 


CONVT 


LIBF 




SPEED 


CALL CONVERSION ROUTINE 


CSP22680 


0070 


0010 




DC 




/0010 


CARD CODE TO EBCDIC 


CSP22690 


0071 1 


0002 




DC 




AREA61 


FROM AREA 


CSP22700 


0072 


0000 


JLAS1 


OC 




• -• 


TO JCARD JLAST 


CSP22710 


0073 


0000 


CNT1 


DC 




«-• 


CHARACTER COUNT 


CSP22720 


007* 


CODO 




LD 




FLAG 


ERROR INDICATOR 


CSP22730 


0075 01 


4C16007A 




BSC 


L 


FINAL. 6- 


ALL DONE IF ZERO 


CSP22740 


0077 


1810 




SRA 




16 


CLEAR ACC 


CSP22750 


0078 


D0D9 




STO 




FLAG 


CLEAR THE INDICATOR 


CSP22760 


0079 


70F5 




MDX 




CONVT 


CONVERT AGAIN 


CSP22770 


007A 20 


22989347 


FINAL 


LIBF 




SWING 


REVERSE THE ARRAY 


CSP22780 


007B 1 


0000 




DC 




JCARD 


FROM JCARD J 


CSP22790 


007C 1 


0072 




DC 




JLAS1 


TO JCARO JLAST 


CSP22800 


0070 20 


19141131 


TEST 


LIBF 




READ! 


CALL BUSY TEST ROUTINE 


CSP22810 


00 7E 


0000 




DC 




/OOOO 


BUSY TEST PARAMETER 


CSP22820 


00 7F 


70FD 




MDX 




TEST 


REPEAT IF BUSY 


CSP22830 


0030 00 


65000000 


SAVE1 


LDX 


LI 


#-# 


RESTORE IR1 


CSP22840 


0032 00 


4COOOO00 


DONE 


BSC 


L 


#-# 


RETURN TO CALLING PROGRAM 


CSP22850 


0084 


0000 


ERROR 


DC 




#-• 


START OF ERROR ROUTINE 


CSP22B60 


0035 00 


04000000 


ERR 


STO 


L 


#-* 


STORE ACC IN ERROR WORD 


CSP22870 



0087 01 74010052 




MDX 


L 


0089 01 4C600084 




BSC 


I 


006B 0001 


ONE 


DC 




008C 




END 





PAGE 2 

FLAG.l SET THE FLAG INDICATOR CSP22880 

ERROR RETURN TO INTERRUPT PROGRM CSP22890 

1 CONSTANT OF ONE CSP22900 

END OF R2501 SUBPROGRAM CSP22910 



NO ERRORS IN ABOVE ASSEMBLY. 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R25Q1 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// OUP 
•STORE 
33B9 0009 



WS UA R2901 



CSP22920 
CSP22930 



// ASM 

•• STACKER SELECT 

• NAME STACK 

•LIST 

0002 229C10D2 



0000 OOOO 


IOCC 


DC 


0001 1460 




DC 


0002 0000 


STACK 


DC 


0003 08FC 




XIO 


0004 01 4C800002 




BSC 


0006 




END 



CSP22940 
SUBROUTINE FOR 1130 COMMERCIAL SUBROUTINE PACKAGE! ID) CSP22950 

(ID) CSP22960 

CSP22970 

ENT STACK STACK SUBROUTINE POINT CSP22980 

• CALL STACK CSP22990 

• SELECTS THE NEXT CARD THROUGH CSP23000 

• THE PUNCH STATION TO THE CSP23010 

• ALTERNATE STACKER ON THE 1442-5. CSP23020 

• 6. OR 7. CSP23030 
I/O COMMAND - FIRST WORD CSP23040 
/14S0 I/O COMMAND - SECOND WORD CSP23050 
•-• RETURN ADDRESS COMES IN HERE CSP23060 
IOCC SELECT STACKER CSP23070 

I STACK RETURN TO CALLING PROG CSP230B0 

CSP23090 



NO ERRORS IN ABOVE ASSEMBLY. 



-185- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// DUP 
•STORE 
33BE 0002 



WS UA STACK 



CSP23100 
CSP23U0 



// ASM 

•» TYPE AND KCYBO SUBROUTINES FOR 1130 CSP 

« NAME TYPER 

• LIST 

003F 23A17139 



(ID) 
110) 



0000 


0001 


0001 


0000 


0002 


003D 


oo if o 


0000 


0040 


691* 


0041 


6178 


0042 


6923 


0043 01 


6980003F 


0049 


4018 


0046 


COBB 


0047 


BOBS 


0048 


ieoi 


0049 


ooas 


004A 


1001 


004B 


DOOS 


004C 20 


195C10D2 


0040 1 


0001 


004E 1 


0083 


004F 1 


0003 


0030 20 


09097663 


0091 


0000 


0052 1 


0003 


0093 1 


0003 


0094 


0000 


0099 20 


23A17170 


0096 


2000 


009? 1 


0002 


0098 


7103 


0059 


6903 


005A 00 


65000000 


005C 00 


4C0OOOO0 


009E 


OOOO 


009F 20 


23A17170 


0060 


0000 


0061 


70F0 


0062 20 


01647880 


0063 1 


0001 


0064 1 


0083 


0065 1 


0002 


0066 


0000 


0067 01 


4C80005E 


0069 


0000 


006A 


69F0 


006B 


613C 


006C 


69F9 


0060 01 


65800069 


006F 


40EE 



ENT TYPER SUBROUTINE ENTRY POINT 

• CALL TYPE (JCAROi Ji JLASTI 

• TYPE JCARDIJI THROUGH JCARDULAST I 

ENT KEYBD SUBROUTINE ENTRY POINT 

• CALL KEYBD IJCARD. Ji JLAST) 

« ENTER AT KEYBOARD JCARDIJI THROUGH JCARDULAST) 

ONE DC 1 CONSTANT OF 1 

JCARO DC •-« JCARD J ADDRESS 

AREA BSS 61 I/O AREA BUFFER 

TYP'R DC •-* FIRST ARGUMENT ADDR HERE 

STX 1 SAVE161 SAVE IR1 

LDX 1 120 PUT 120 IN IR1 

STX 1 MAXCH STORE IT AS MAX CHARS 

LDX II TYPER PUT FIRST ADDR IN IRl 

BSI SETUP GO TO SETUP 

L-0 AREA GET CHARACTER COUNT 

A ONE HALF ADJUST IT AND 

SRA 1 DIVIDE IT BY TWO 

STO AREA AND REPLACE IT 

SLA 1 DOUBLE IT 

STO CNT1 AND PUT IT IN CNT1 

LIBF RPACK CALL REVERSE PACK ROUTINE 

DC JCARD FROM JCARD J 

DC JLAST TO JCARD JLAST 

DC AREA61 PACK INTO I/O AREA 

LIBF EBPRT CALL CONVERSION ROUTINE 

DC /OOOO FROM EBCDIC 

DC AREA61 TO PRINTER CODE. 

DC AREAH ALL IN THE I/O AREA 

CNT1 DC •-• HALF ADJSTD CHARACTER CNT 

LIBF TYPEO CALL TYPE ROUTINE 

DC /2000 TYPE PARAMETER 

DC AREA I/O AREA BUFFER 

FINAL MDX 1 3 INCREMENT OVER 3 ARGUMENTS 

STX 1 DONE&l STORE IRl 

SAVE1 LDX LI •-• RESTORE IRl 

DONE BSC L »-« RETURN TO CALLING PROGRAM 

SETUP DC »-• START OF SETUP ROUTINE 

TEST LIBF TYPEO CALL BUSY TEST ROUTINE 

DC /OOOO BUSY TEST PARAMETER 

MDX TEST REPEAT TEST IF BUSY 

LIBF ARGS CALL ARGS ROUTINE 

DC JCARO 15T ARGUMENT TO JCARO J 

DC JLAST TO JCARD JLAST 

OC AREA TO CHARACTER COUNT 

MAXCH DC »-• MAXIMUM NUMBER OF CHARS 

BSC I SETUP END OF SETUP. RETURN 

KEYBO DC »-• START OF KEYBOARD ROUTINE 

STX 1 SAVElil SAVE IRl 

LDX 1 60 PUT BUFFER LENGTH IN IRl 

STX 1 MAXCH 60 IS MAX NO OF CHARS 

LDX II KEYBD 1ST ARGUMENT ADDR IN IRl 

BSI SETUP GO TO SETUP 



CSP23120 
CSP23130 
CSP23140 
CSP23150 
CSP23160 
CSP231T0 
CSP23180 
CSP23190 
CSP23200 
CSP23210 
CSP23220 
CSP23230 
CSP23240 
CSP23250 
CSP23260 
CSP23270 
CSP23280 
CSP23290 
CSP23300 
CSP23310 
CSP23320 
CSP23330 
CSP23340 
CSP23350 
CSP23360 
CSP23370 
CSP23380 
CSP23390 
CSP23400 
CSP23410 
CSP23420 
CSP23430 
CSP23440 
CSP23430 
CSP23460 
CSP23470 
CSP23480 
CSP23490 
CSP23300 
CSP23910 
CSP23520 
CSP23930 
CSP23540 
CSP23950 
CSP23560 
CSP23570 
CSP23530 
CSP23990 
CSP23600 
CSP23610 
CSP23620 
CSP23630 
CSP23640 
CSP23650 
CSP23660 
CSP23670 
CSP23680 



0070 





613C 




LDX 


1 60 


PUT BUFFER LENGTH IN IRl 


CSP23690 


0071 





1810 




SRA 


16 


CLEAR THE ACC 


CSP23700 


0072 


01 


D5000002 


CLEAR 


STO 


LI AREA 


CLEAR THE I/O BUFFER 


CSP23710 


0074 





71FF 




MDX 


1 -1 


DECREMENT IRl 


CSP23720 


0075 





70FC 




MDX 


CLEAR 


AND CONTINUE CLEARING 


CSP23730 


0076 


01 


69800069 




LDX 


11 KEYBD 


1ST ARGUMENT ADDR IN IRl 


CSP23740 


0078 





C089 




LD 


AREA 


PUT CHARACTER COUNT 


CSP23750 


0079 





DOOA 




STO 


CNT2 


IN CNT2 


CSP23760 


007A 


20 


23A17170 




LIBF 


TYPEO 


CALL KEYBOARD ROUTINE 


CSP23770 


007B 





1000 




DC 


/1000 


KEYBOARD PARAMETER 


CSP23780 


007C 


1 


0002 




DC 


AREA 


I/O AREA BUFFER 


CSP23790 


0070 


20 


23A17170 


TEST1 


LIBF 


TYPEO 


CALL BUSY TEST ROUTINE 


CSP23800 


007E 





OOOO 




DC 


/OOOO 


BUSY TEST PARAMETER 


CSP23810 


00 7F 





70F0 




MDX 


TEST1 


REPEAT TEST IF BUSY 


CSP23820 


0080 


20 


225C5144 




LIBF 


SPEED 


CALL CONVERSION ROUTINE 


CSP23830 


0081 





0010 




OC 


/0010 


CARD CODE TO EBCDIC 


CSP23840 


0082 


1 


0003 




DC 


AREA61 


FROM THE I/O AREA BUFFER 


CSP23850 


0083 





OOOO 


JLAST 


DC 


*-« 


TO JCARO JLAST 


CSP23860 


0084 





OOOO 


CNT2 


OC 


• -• 


CHARACTER COUNT 


CSP23870 


0085 


20 


22989947 




LIBF 


SWING 


CALL REVERSE ARRAY 


CSP23S80 


0086 


1 


0001 




DC 


JCARO 


REVERSE FROM JCARD J 


CSP23690 


0087 


1 


0083 




DC 


JLAST 


TO JCARD JLAST 


CSP23900 


0088 





70CF 




MDX 


FINAL 


ALL THROUGH. GO TO FINAL 


CSP23910 


00 8A 








END 




END OF TYPE SUBPROGRAM 


CSP23920 



NO ERRORS IN ABOVE ASSEMBLY, 



-186- 



// DUP 

•STORE WS UA TYPER 

33C0 0006 



CSP23930 
CSP23940 



// ASM 

»» PACK /UNPAC SUBROUTINES FOR 

* LIST 

• NAME UNPAC 

0000 24557043 ENT 



1130 COMMERCIAL SUBROUTINE PACKAGE 



( 10) 



0000 





0000 


UNPAC 


DC 




0001 





C003 




LD 




0002 





ooie 




STO 




0003 





7007 




MDX 




0004 





7009 


SW1 


MDX 


X 


0003 





7000 


SW2 


MDX 


X 


0006 





0000 


PACK 


DC 




0007 





COFE 




LD 




oooe 





00F7 




STO 




0009 





COFA 




LD 




OOOA 





D016 




STO 




OOOB 





6930 


START 


5TX 


1 


oooc 


01 


65800000 




LDX 


11 


OOOE 





C100 




LD 


1 


OOOF 





8001 




A 




0010 


00 


95800001 


ONE 


S 


11 


0012 





DOOD 




STO' 




0013 





C103 




LD 


1 


0014 





60FC 




A 


4 


0019 


00 


95800004 




S 


11 


0017 





D006 




STO 




0018 





C100 




LD 


1 


0019 





80F7 




A 




001A 


00 


95800002 




S 


11 


001C 





D0E9 




STO 




ooio 


00 


69000000 


KCARO 


LDX 


LI 


001F 


00 


C4000000 


JCARO 


LD 


L 


0021 





7000 


SWTCH 


MDX 


X 


0022 





1888 




SRT 




0023 





1008 




SLA 




0024 





ES1A 




OR 




0025 





0100 




STO 


1 


0026 





71FF 




MDX 


1 


0027 





1088 




SLT 




002S 





1008 




SLA 




0029 





E815 




OR 




00 2A 





7006 




MDX 




002B 





1398 


ELSE 


SRT 




00 2C 


01 


74FF0020 




MDX 


L 


002E 


01 


C4800020 




LD 


I 


0030 





18CS 




RTE 




0031 





D100 


FINIS 


STO 


1 


0032 


01 


74FF0020 




MOX 


L 



(ID) 
UNPAC UNPACK SUBROUTINE ENTRY POINT 
CALL UNPAC I JCARD. J. JLAST .KCARD. K I 
THE WORDS JCARO J THROUGH 
JCARD JLAST IN A2 FORMAT ARE 
UNPACKED INTO KCARD K IN Al FORMAT. 
PACK PACK SUBROUTINE ENTRY POINT 
CALL PACKIJCAR0.J.JLA5T.KCARD.KI 
THE WORDS JCARD J THROUGH 
JCARO JLAST IN Al FORMAT ARE PACKED 
INTO KCARD K IN A2 FORMAT. 
*-* ARGUMENT ADDRESS COMES IN HERE 
SW2 LOAD NOP INSTRUCTION 
SWTCH STORE NOP AT SWITCH 
START COMPUTING 
ELSE-SWTCH-1 BRANCH TO ELSE 
NOP INSTRUCTION 

«-* ARGUMENT ADDRESS COMES IN HERE 
PACK PICK UP ARGUMENT ADDRESS 
UNPAC AND STORE IT IN UNPAC 
SW1 LOAD BRANCH TO ELSE 
SWTCH STORE BRANCH AT SWITCH 
SAVE161 SAVE IR1 
UNPAC PUT ARGUMENT ADDRESS IN IR1 

GET JCARO ADDRESS 
ONE+1 ADD CONSTANT OF 1 

1 SUBTRACT J VALUE 

JCARD+1 CREATE JCARD(J) ADDRESS 

3 GET KCARD ADDRESS 
ONE+1 ADD CONSTANT OF 1 

4 SUBTRACT K VALUE 

KCARD+1 CREATE KCARD(K) ADDRESS 
GET JCARD ADDRESS 
ONE+1 ADD CONSTANT OF 1 

2 SUBTRACT JLAST VALUE 

PACK CREATE JCARD JLAST ADDRESS 

•-• PUT KCARD ADDRESS IN IS1 

♦-• PICK UP JCARDIJI 

SWITCH BETWEEN PACK AND UNPACK 

6 SHIFT LOW ORDER BITS TO EXT 

8 REPOSITION HIGH ORDER BITS 

BMASK PUT BLANK IN LOW ORDER BITS 

PUT IN KCARD K 

-1 DECREMENT KCARD ADDRESS 

8 MOVE THE EXTEN INTO THE ACCUM 

8 IN TWO STEPS 

BMASK PUT BLANK IN LOW ORDER BITS 

FINIS BRANCH AROUND PACK ROUTINE 

24 SHIFT HIGH ORDER BITS INTO EXT 

JCARD+l.-l DECREMENT JCARD ADDRESS 

JCARD+1 PICK UP JCARDIJ+ll 

8 SHIFT IN BITS FROM EXT 

PUT IN KCARD K 

JCARD+l.-l DECREMENT JCARD ADDRESS 



CSP23950 
CSP23960 
CSP23970 
CSP23980 
CSP23990 
CSP24000 
CSP24010 
CSP24020 
CSP24030 
CSP24040 
CSP24050 
CSP24060 
CSP24070 
CSP24080 
CSP24090 
CSP24100 
CSP24110 
CSP24120 
CSP24130 
CSP24140 
CSP24150 
CSP24160 
CSP24170 
CSP241S0 
CSP24190 
CSP24200 
CSP24210 
CSP24220 
CSP24230 
CSP24240 
CSP24250 
CSP24260 
CSP24270 
CSP24280 
CSP24290 
CSP24300 
CSP24310 
CSP24320 
CSP24330 
CSP24340 
CSP24350 
CSP24360 
CSP24370 
CSP24380 
CSP24390 
CSP24400 
CSP24410 
CSP24420 
CSP24430 
CSP24440 
CSP24450 
CSP24460 
CSP24470 
CSP24480 
CSP24490 
CSP24500 
CSP24510 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



0034 


71FF 




MDX 


1 


0035 


COEA 




LD 




0036 


90CF 




S 




0037 01 


4C10001F 




BSC 


L 


0039 01 


74050000 




MDX 


L 


003B 00 


65000000 


SAVE1 


LDX 


LI 


003D 01 


4C800000 




BSC 


1 


003F 
0040 


0040 


BMASK 


DC 
END 





-1 DECREMENT KCARD ADORESS 

JCARD+1 GET JCARDIJI ADDRESS 

PACK SUBTRACT JCARD JLAST ADDRESS 

JCARD.- CONTINUE IF DIFFERENCE 6 OR 

UNPAC. 5 CREATE RETURN ADDRESS 

*-• RESTORE IR1 

UNPAC RETURN TO CALLING PROGRAM 

/40 MASK 0000000001000000 



PAGE 2 

CSP24520 
CSP24530 
CSP24S40 
CSP24550 
CSP24560 
CSP24570 
CSP245B0 
CSP24590 
CSP24600 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
33C6 0005 



WS UA UNPAC 



CSP24610 
CSP24620 
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ADD 
A1A3 
A1DEC 
A3A1 
CARRY 
DECA1 
DIV 

DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYED 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH- 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



// ASM 












** WHOLE NUMBER SUBROUTINE FOR 


1130 COMMERCIAL SUBROUTINE PACKAGE (101 


« NAME 


WHOLE 








IID) 


• LIST 












0006 




262164C5 




ENT 


WHOLE 


SUBROUTINE ENTRY POINT 








» X-WHOLEIYI. WITH Y IN 


FAC TO START 








* X IN FAC 


BECOMES THE 


INTE6RAL PART OF Y. 


0000 





0000 


DBL1 


DC 





DBL CONSTANT OF 1 


0001 





oooi 




DC 


1 


REST OF DBL1 CONSTANT 


00 IF 






MANT 


EQU 


31 


MANTISSA LENGTH 


0002 





009F 


C159 


DC 


12S+MANT 


EXPONENT OF FULL INTEGER 


0003 





001F 


C31 


DC 


MANT 


MANTISSA LENGTH 


0004 





189F 


SRT 


SRT 


MANT 


SRT MANTISSA LENGTH 


0005 





OBOO 


H080D 


DC 


/0800 


DIFF BETWEEN SRT AND SLT 


0006 





0000 


WHOLE 


DC 


*~« 


ARGUMENT ADDRESS HERE 


0007 





COFA 




LD 


C159 


EXP OF FULL INTEGER 


oooa 





9370 




S 


3 129 


SUBTRACT EXP OF 1 


0009 


01 


4C2B001A 




BSC 


L DONE.+Z 


BRANCH IF ALL INTEGER 


O0OB 





90F7 




s 


C31 


SUBTRACT MANTISSA LENGTH 


00OC 


01 


4C10001E 




BSC 


L FRACT. - 


BRANCH IF ALL FRACTIONAL 


000E 





B0F5 




A 


SRT 


CREATE RIGHT SHIFT 


OOOF 





0005 




STO 


RIGHT 


STORE RIGHT SHIFT 


0010 





90F4 




s 


H0800 


CREATE LEFT SHIFT 


0011 





D006 




STO 


LEFT 


STORE LEFT SHIFT 


0012 





CB7E 




LDD 


3 126 


PICK UP MANTISSA 


0013 





4828 




BSC 


♦ Z 


CHECK FOR NEGATIVE MANTISA 


0014 





98EB 




SD 


DBL1 


SUBTRACT 1 IF NEGATIVE 


0019 





1880 


RIGHT 


SRT 


#-» 


RIGHT SHIFT 


0016 





4828 




BSC 


♦ Z 


CHECK FOR NEGATIVE MANTISA 


0017 





88E8 




AD 


DBL1 


ADD 1 IF NEGATIVE 


0018 





1080 


LEFT 


SLT 


«-« 


LEFT SHIFT 


0019 





0B7E 


STORE 


STD 


3 126 


STORE MANTISSA 


00 1* 


01 


74010006 


DONE 


MDX 


L WHOLE. 1 


CREATE RETURN ADDRESS 


00 1C 


01 


4C800006 




BSC 


I WHOLE 


RETURN TO CALLING PROGRAM 


001E 





10E0 


FRACT 


5LC 


32 


ZERO ACC AND EXT 


001F 





037D 




STO 


3 129 


ZERO THE EXPONENT 


0020 





70F8 




HDX 


STORE 


ZERO THE MANTISSA 


0022 








END 




END OF WHOLE SUBROUTINE 



CSP24630 
CSP24640 
CSP246S0 
CSP24660 
CSP24670 
CSP24680 
CSP24690 
CSP24700 
CSP24710 
CSP24720 
CSP24730 
CSP24740 
CSP24750 
CSP24760 
CSP24770 
CSP24780 
CSP24790 
CSP24800 
CSP24810 
CSP24S20 
CSP24830 
CSP24840 
CSP24850 
CSP24860 
CSP24870 
CSP24880 
CSP24890 
CSP24900 
CSP24910 
CSP24920 
C5P24930 
CSP24940 
CSP24950 
CSP24960 
CSP24970 
CSP24980 
CSP24990 
CSP25000 



NO ERRORS IN ABOVE ASSEMBLY. 



// OUP 
»STORE 
33CB 0003 



WS UA WHOLE 



CSP2S010 
CSP2S020 
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// ASM 

»» ARGS. RPACK AND 

• LIST 

» NAME ARSS 



SWING SUBROUTINES FOR .130 CSP 



004F 

0000 

0001 

0002 

0003 00 

0005 

0006 00 

0008 

0009 00 
OOOB 
OOOC 00 
OOOE 
OOOF 00 
0011 00 
0013 
001k 01 

0016 

0017 01 

0019 
001A 
00 IB 00 
00 ID 00 
001F 

0020 

0021 00 

0023 

0024 

0025 00 

0027 

0028 00 
002A 
0023 
002C 00 
002E 00 

0030 

0031 00 
0033 00 

0035 

0036 00 
0036 

0039 
003A 
003B 00 
003D 
003E 01 

0040 01 



22989547 

0001 

0000 

6A2A 

66800000 

C100 

95800002 

80F7 

06800001 

C100 

95800001 

80F1 

D6S0OOOO 

96800001 

80EC 

4C08001B 

9203 

4C300021 

8203 

7000 

C68OO0OO 

D6800001 

COEO 

7007 

C6800000 

9203 

80DB 

DtSOOOOl 

C203 

D6800002 

7204 

6A03 

66000000 

4C000000 

6AFC 

66800000 

C6800000 

0006 

C6800001 

DOCS 

C202 

D009 

C4000000 

1898 

74FF003C 

C480003C 



LISR 
THESE SUBROUTINES 

ENT ARGS 
ARGS SETS THE ARGUf 

ENT RPACK 
RPACK REVERSES AND 

ENT SWING 
SWING REVERSES AN 



ONE 

JLAST 

ARGS 



DC 

DC 

STX 

LDX 

LD 

S 

A 

STO 

LD 

S 

A 

STO 

S 



BSC 
S 

BSC 
A 

MDX 
EROl LD 
STO 
LD 
MDX 
ERROR LD 
S 
A 

STO 
LD 
OK STO 
MDX 
LAST STX 
SAVE2 LDX 
DONE BSC 
RPACK STX 
LDX 
LD 
STO 
LD 
STO 
LD 
STO 
JCARD LD 
SRT 
MDX 
LD 



I IDI 

libf type routines follow 
c innot be called from fortran 

subroutine entry point 
m:nt for the i/o routines 
subroutine entry point 
'acks ebcdic strings 

subroutine entry point 
e icdic string 
1 constant of one 
•-• jcard(jlast) address 
2 save2gi args routine starts here 
12 get 1st argument addr 
1 get jcard addr 
ii 2 subtract jlast value 

one ado one 
12 1 store in 2n0 arg 

1 get jcard addr 
ii 1 subtract j value 

one add one 

12 store in 1st arg 

12 1 subtract jlast addr 

one add one 

l er0r1.+ check for neg or chars 

2 3 ok. subtract max chars 

l error.-! check more than max chars 

2 3 add max chars back 

ok addresses ok 

12 pick up jcard(j) 

12 1 and store in jcardijlast1 

one set up char count of 1 

ok go to store char count 

12 pick up jcardij) 

2 3 and calculate jcard! jlast i 

ONE TO BE JCARDIJ+MAX-ll 

12 1 STORE ADDR IN JCARD I JLAST I 

2 3 LOAD CHARACTER COUNT 

12 2 STORE CHARACTER COUNT 

2 4 CREATE RETURN ADDR 

2 D0NES1 STORE RETURN ADDRESS 

L2 ♦-» RESTORE IR2 

L *-« RETURN TO CALLING PROGRAM 

2 SAVE2S1 RPACK ROUTINE STARTS HERE 

12 GET 1ST ARGUMENT ADDRESS 

12 GET JCARD ADDR 

JCARDS1 INITIALIZE JCARD ADDRESS 

12 1 GET SECOND ARGUMENT ADDR 

JLAST INITIALIZE JCARD JLAST 

2 2 GET AREA ADDRESS 

KCARD&l INITIALIZE PACK TO ADDRESS 

L «-• LOAD FIRST CHARACTER 

24 SHIFT INTO EXT 
L JCARD41.-1 DECREMENT ADDRESS 

I JCARDS1 GET SECOND CHARACTER 



CSP25030 
CSP25040 
CSP25050 
CSP25060 
CSP25070 
CSP2508O 
CSP25090 
CSP25100 
CSP25110 
CSP25120 
CSP25130 
CSP25140 
CSP25150 
CSP25160 
CSP25170 
CSP25180 
CSP25190 
CSP25200 
CSP25210 
CSP25220 
CSP25230 
CSP25240 
CSP25250 
CSP25260 
CSP25270 
CSP25280 
CSP25290 
CSP25300 
CSP25310 
CSP25320 
CSP25330 
CSP25340 
CSP26350 
CSP25360 
CSP25370 
CSP253S0 
CSP25390 
CSP25400 
CSP25410 
CSP23420 
CSP25430 
CSP25440 
CSP25450 
CSP25460 
CSP25470 
CSP25480 
CSP2549C 
CSP25500 
CSP25510 
CSP25520 
CSP25530 
CSP25540 
CSP25550 
CSP25560 
CSP25570 
CSP25580 
CSP25590 



0042 





18C8 




RTE 




8 




0043 


00 


04000000 


KCARD 


STO 


L 


tt-ft 




0045 


01 


74FF003C 




MDX 


L 


JCARD61 


.-1 


0047 


01 


74010044 




MDX 


L 


KCARD61 


>S1 


0049 





C0F2 




LD 




JCARD61 




004A 





90B6 




S 




JLAST 




004B 


01 


4C10OO3B 




BSC 


L 


JCARD.- 




004D 





7203 




MDX 


2 


3 




004E 





70DC 




MDX 




LAST 




004F 





6AD0 


SWING 


STX 


2 


SAVE2S1 




0050 


00 


66S00000 




LDX 


12 







0052 


00 


C6800000 




LD 


12 







0034 





D007 




STO 




BACK01 




0055 


00 


C6800001 




LD 


12 


1 




0057 





D001 




STO 




FR0NTS1 




0058 


00 


C40C0000 


FRONT 


LD 


L 


#-• 




005A 





1890 




SRT 




16 




OOSB 


00 


C4000000 


BACK 


LD 


L 


*-* 




005D 





E810 




OR 




HEX40 




OOSE 


01 


D4800039 




STO 


1 


FRONT&l 




0060 





1090 




SLT 




16 




0061 





E80C 




OR 




HEX40 




0062 


01 


D480005C 




STO 


I 


BACKS1 




0064 


01 


74010059 




MDX 


L 


FR0NT51 


• 61 


0066 


01 


74FF005C 




MDX 


L 


BACKfcl. 


-1 


0068 





COFO 




LD 




FRONTS 1 




0069 





90F2 




S 




BACK+1 




006A 


01 


4C08005S 




BSC 


L 


FRONT. 6 




006C 





7202 




MDX 


2 


2 




006D 





70BD 




MDX 




LAST 


006E 





0040 


HEX40 


DC 




/0040 


0070 








END 









SHIFT RIGHT. RETRIEVE EXT 
STORE IN AREA 
DECREMENT ADDRESS 
INCREMENT AREA ADDRESS 
GET ENDING ADDRESS 
SUBTRACT JCARD JLAST ADDR 
REPEAT IF NOT MINUS 
INCREMENT OVER 3 ARGS 
ALL THROUGH. GO TO LAST 
SWING ARRAY END FOR END 
GET 1ST ARGUMENT ADDRESS 
GET FIRST ARGUMENT 
STORE AT BACK ADDRESS 
GET 2ND ARGUMENT 
STORE AT FRONT AODRESS 
GET WORD FROM FRONT 
PUT IT IN THE EXT 
GET A WORD FROM THE BACK 
OR IN AN EBCDIC BLANK 
PUT IT IN THE FRONT 
RETRIEVE THE EXT 
OR IN AN EBCDIC BLANK 
PUT IT IN THE BACK 
INCREMENT THE FRONT ADDR 
DECREMENT THE BACK ADDR 
GET THE FRONT ADDRESS 
SUBTRACT THE BACK AODRESS 
REPEAT IF MINUS 
INCREMENT OVER 2 ARGS 
ALL THROUGH. GO TO LAST 
EBCDIC BLANK CODE 
END OF ARGS SUBPROGRAM 
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CSP25600 
CSP25610 
CSP25620 
CSP25630 
CSP25640 
CSP25650 
CSP25660 
CSP25670 
CSP25680 
CSP25690 
CSP25700 
CSP25710 
CSP25720 
CSP25 730 
CSP25740 
CSP25750 
CSP25760 
CSP25770 
CSP25780 
CSP25790 
CSP25800 
CSP25810 
CSP25820 
CSP25830 
CSP25840 
CSP25850 
CSP25360 
CSP25870 
CSP25880 
CSP25890 
CSP25900 
CSP25910 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
♦STORE 
33CE 0008 



WS UA ARGS 



CSP25920 
CSP25930 
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APPENDIX 



CORE ALLOCATION 



To calculate the core requirements, sum the number of words for all routines used. If 
NZONE, CARRY, NSIGN, SERVICE, WHOLE, ADD, and/or FILL are not included in the 
first sum, and they are CALLed by a routine in the first sum, add their number of words 
to the first sum. Then calculate the Reference core requirements. Keep in mind that no 
matter how many times a Reference is used, it should be considered only once. Sum the 
core requirements of all References used. Add this sum to the first sum. The resulting 
total is the core requirement for the 1130 Commercial Subroutine Package. Notice that 
the FORTRAN subroutines a, b, and c will be used by most FORTRAN programs and so 
will be present whether the package is used or not. 
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Number of 


Calls These CSP 


Calls These Subroutine 


CSP Routine Name 




Words 


Routines 


Library Routines 


A1DEC 




74 


NZONE 


- 


A1A3/A3A1 




152 


- 


- 


ADD/SUB 




170 


CARRY, FILL 


- 


ARGS 




112 


- 


- 


CARRY 




54 


- 


- 


DECA1 




76 


NZONE 


- 


DIV 




238 


CARRY, FILL 


- 


DPACK/DUNPK 




100 


- 


- 


EDIT 




204 


NZONE, FILL 


- 


FILL 




30 


- 


- 


GET 




96 


NZONE 


ref. a and b 


ICOMP 




122 


- 


- 


IOND 




6 


- 


- 


MOVE 




36 


- 


- 


MPY 




164 


CARRY, FILL 


- 


NCOMP 




42 


- 


- 


NSIGN 




42 


- 


- 


NZONE 




78 


- 


- 


PACK/UNPAC 




66 


- 


- 


PRINT/SKIP 




124 


ARGS 


ref. e 


PUT 




104 


NZONE, WHOLE 


ref. a, b, and c 


P1403/S1403 




134 


ARGS 


ref. j 


P1442 




130 


ARGS 


ref. i 


READ/PUNCH 




158 


ARGS 


ref. f and h 


R2501 




140 


ARGS 


ref. d and h 


STACK 




6 


- 


- 


TYPER/KEYBD 




138 


ARGS 


ref. g and h 


WHOLE 




34 


- 


- 


References 








a. (EADD, EMP 


Y,ESTO, FLOAT,] 


TORM) 342 words 




b. (SNR) 8 wore 


Is 






c. (EABS, IFDQ 


74 words 






d. (READ1) 11C 


words 






e. (PRNT1) 404 


words 






f. (CARD1) 264 


words 






g. (TYPEO, EB] 


?RT) 638 words 






h. (SPEED, ILS 


)4) 360 words 






i. (PNCH1) 218 


words 






j. (PRNT3, ZEE 


»CC 


>, EBPT3) 544 v. 


'ords 
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EBCDIC CHARACTERS AND DECIMAL EQUIVALENTS 



A 


-16064 


S 


-7616 


blank 


16448 


B 


-15808 


T 


-7360 


. (period) 


19264 


C 


-15552 


U 


-7104 


< (less than) 


19520 


D 


-15296 


V 


-6848 


( 


19776 


E 


-15040 


w 


-6592 


+ 


20032 


F 


-14784 


X 


-6336 


& 


20544 


G 


-14528 


Y 


-6080 


$ 


23360 


H 


-14272 


Z 


-5824 


* 


23616 


I 


-14016 





-4032 


) 


23872 


J 


-11968 


1 


-3776 


- (minus) 


24640 


K 


-11712 


2 


-3520 


/ 


24896 


L 


-11456 


3 


-3264 


» 


27456 


M 


-11200 


4 


-3008 


% 


27712 


N 


-10944 


5 


-2752 


# 


31552 





-10688 


6 


-2496 


@ 


31808 


P 


-10432 


7 


-2240 


' (apostrophe) 


32064 


Q 


-10176 


8 


-1984 


= 


32320 


R 


-9920 


9 


-1728 
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TIMING DATA 



Subprogram Name 



GET 

PUT 

EDIT 

MOVE 

FILL 

WHOLE 

NCOMP 

NZONE 

ICO MP 

NSIGN 

ADD 

SUB 

MPY 

DIV 

A1DEC 

DECA1 

A1A3 

A3A1 

PACK 

UNPAC 

DPACK 

DUNPK 



Approximate* Execution Time in Microseconds** 



2250 + 2190 C 
3450 + 3090 C 



90 S + 180 M 
45 C 
C 



630 + 

300 + 

300 + 30 
1400 

250 + 75 C 

350 

500 + 95 C 

240 
2160 + 216 L 
2160 + 216 L 
2400 + 120 P 
4000 + Q (445 + 667 DIV) 



All 
cases, 
may 
given 



** 



700 + 
180 + 
470 + 
545 + 
360 + 
420 + 
392D 
360D 



54 A 

117 A 

1084 A 

156 A 

63 A 

66 A 



C = Lengthl of the field, in characters 

S = Length of the source field 

M = Length of the edit mask 

P = Length of the multiplier field x length of the multiplicand field (significant 

digits only—don't count leading zeros) 
A = Length of the Al field 
D = Length of the packed decimal (D4) field 
L = Length of the longer of the two fields (significant digits only—don't count 

leading zeros) 
Q = Number of significant digits in the quotient (result) field 
DIV = Number of significant digits in the divisor (denominator) field 



tilings are approximate, and are based on test runs of "typical" 
using fields of "average" size, magnitude, etc. Unusual cases 
(cir may not) differ significantly from the timings obtained from the 
oquations. This is particularly true of the decimal arithmetic 
routines (ADD, SUB, MPY, DIV). 



Based on 3. 6-microsecond CPU cycle speed, 
timings on 2. 2-microsecond CPU. 



Multiply by 0. 6 to obtain 
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1 130 Commercial Subroutine Package (1 130-SE-25X), Version 3, Programmers Reference Card 



Format of Data 



Format of Commercial Subrouti ne Calls (and Parameters*) 
Page 

Nos.** 

*ONEWORD INTEGERS -- 

♦EXTENDED PRECISION 

*IOCS(DISK) " .„ 

CALLADD(JCARD,J,JLAST,KCARD,K,KLAST,NER) 3 

CALLA]A3(JCARD,J,JLAST,KCARD,K,ICHAR) » 

CALLA1DEC(JCARD,J,JLAST,NER)---- '° 

CALLA3AigC AR D,J,JlAVr,KCARD,K,ICHAR) i * 

CALLDECA1(JCARD,J,JLAST,NER) f 

CALL DIV(JCARD,J,JLAST,KCARD,K,KLAST,NER) f 

CALLDPACK(JCARD,J,JLAST,KCARD,K) 1\ 

CALL DUNPK(JCARD,J,JLAST,KCARD,K) £ 

CALL EDIT(JCARD,J,JLAST,KCARD,K,KLAST) M 

CALLFILL(JCARD,J,JLAST,NCH) ""*' 

GET(JCARD,J,JLAST,SHIFT) * 

|COMP(JCARD,J,JLAST,KCARD,K,KLAST) « 

CALLIOND " "" 48 

CALLKEYBD(JCARD,J,JLAST) --- Q 

CALLMOVE(JCARD,J,JLAST,KCARD,K) \ 

CALLMPY(JCARD,J,JLAST,KCARD,K,KLAST,NER) « 

NCOMP(JCARD,JJLAST,KCARD,K) ^ 

CALLNSIGN(JCARD,J,NEWS,NOLDS) *> 

CALLNZONE(JCARD,J,NEWZ,NOLDZ) » 

CALLPACK(JCARD,J,JLAST,KCARD,K) - °" 

CALL PRINT(JCARD,J,JLAST, NER) --- °f 

CALLPUNCH(JCARD,J,JLAST,NER) °T 

CALLPUT(JCARD,J,JLAST,VAR,ADJST,N) °° 

CALLP1403(JCARD,J,JLAST,NER) °° 

CALLP1442(JCARD,J,JLAST,NER) 1" 

CALL READ(JCARD,J,JLAST, NER) '" 

CALL R2501(JCARD,J,JLAST, NER) 1° 

CALLSKIP(N) - " g. 

CALLS1403(N) 81 

CALL STACK --- „- 

CALL SUB(JCARD,J,JLAST,KCARD,K,KLAST, NER) « 

CALLTYPER(JCARDJ,JLAST) °° 

CALL UNPAC(JCARD, J , JLAST, KCARD,K) °* 

WHOLE(EXPRESSION) 



Comments on Parameters 



Before 



Dl 
Al 
Al 
A3 
~DT~ 



After 



— Must use for every CSP program ■- ~~ " ■--- 

— Must use if G ET or PUT is present " ' 

— Only DISK can be specified for CSP I/O - 

Dl Initialize NER to 0; error if NER=KLAST 

A3 You must define ICHAR array, and it must contain 40 characters 

Dl Initialize NER to 0; error if NER/0 

Al You must define ICHAR array, and it must contain 40 characters 

-^1 I n i tia li ze NER -t u 0; e n ui i rN C R^O - ■■- — 

Dl ' Initialize NER to 0; error if NER=K LAST 

D4 

D1 

Al Control characters in mask are: b0.,CR-*S 

Al See reverse side for decimal values for NCH 

Real*** I SHIFT must be real, extended precision. (1 .0=no shift) 

-0+ Minus:JCARD<KCARD;Zero:JCARD=KCARD;Plus:JCARD>KCARD. 

None Use before PAUSE or STOP (Monitor Version 1 Only) 

Al Maximum of 60 Characters al lowed 

Same " ' ' 

Dl Initialize NER to 0; error if NER=KLAST 

-0+ Minus:JCARD<KCARD;Zero:JCARD=KCARD;Plus:JCARD>KCARD. 

Integer See reverse side for values for NEWS and NOLDS 

Integer See reverse side for values for NEWZ and NOLDZ 

£2 

Al Initialize NER to 0; if NER=3, reached chan.9; if NER=4, reached chan. 12 

Al Initialize NER to -1; if NER=0, last card, if NER=1, feed or punch check- - 

Al VAR and ADJST must be real, extended precision -: 

Al Initialize NER to 0; if NER=3, reached chan. 9; if NER=4, reached chan. 12 

Al Initialize NER to -1; if NER=0, last card; if NER=1, feed or punch check -- 

Al Initialize NER to -1; if NER=0, last card; if NER=1, feed or read check 

Al Initialize NER to -1; if NER=0, lastcard; if NER=1, feed or read check --- 

None See reverse side for functional values for N ■- " 

None See reverse side for functional values for N 

None 

Dl Initialize NER to 0; error if NER=KLAST "" 

Al See reverse side for values for functional characters 

A1 

Real The expression must be "real" not "integer". 



to 

I 



Dl 

Dl 

D4 

Al 

Dec. 

Al 

Al 

None 

Al 

Any 

Dl 

Al 

Dl 

Al 

Al 

Al 

Al 

Real** 

Al 

Al 

Al 

Al 

Dec. 

Dec. 

None 

Dl 

Al 

A2 

Real 



* All parameters required by each subroutine must be supplied. 

** Page Number in 1130 Commercial Subroutine Package (1 130-SE-25X), Version 3 Program Reference Manual (H20-6241-3) 

*** Must use extended precision in calling program. 





FILL and 


NCOMP 








EBCDIC Char. 


Dec. Equiv. 


NSIGN - used with Dl fields 




Low (12-0) 


-16320 








A 


-16064 


If NOLDS IS: 


Then sign was: 




B 


-15808 


+1 


positive 




C 


-15552 


-1 


negative 




D 


-15296 








E 


-15040 








F 


-14784 


When NEWS is: 


Sign is set to: 




G 


-14528 


+1 


positive 




H 


-14272 





opposite of old sign 




1 


-14016 


-1 


negative 




(11-0) 


-12224 


NOLDS 


no change 




J 
K 
L 


-11968 
-11712 
-11456 






NZONE - used with Al fields 






M 


-11200 








N 


-10944 


If NOLDZ is: 


Then character was: 




O 


-10688 


1 
2 


A-l 




P 


-10432 


J-R 




Q 


-10176 


3 


S-Z 




R 


-9920 


4 


0-9 




S 


-7616 


more than 4 


special 




T 


-7360 








S u 


-7104 








5 V 


-6848 


When NEWZ is: 


Character is set to: 




1 w 


-6592 


1 


12 zone 


t 


n X 


-6336 


2 


1 1 zone 


. 


: Y 


-6080 


3 


zone 


- 


5 Z 


-5824 


4 


no zone 




3 




more than 4 


no change 


1 


E 


-4032 
-3776 










-I 


2 2 


-3520 


SKIP and SI 403 function 


Value for N 


- 


3 


-3264 








4 


-3008 


Immediate skip to channel 1 


12544 




5 


-2752 


Immediate skip to channel 2 


12800 




6 


-2496 


Immediate skip to channel 3 


13056 




7 


-2240 


Immediate skip to channel 4 


13312 




8 


-1984 


Immediate skip to channel 5 


13568 




9 


-1728 


Immediate skip to channel 6 
Immediate skip to channel 9 
Immediate skip to channel 12 


13824 
14592 
15360 




blank 


16448 


Immediate space of 1 space 


15616 




. (period) 


19264 


Immediate space of 2 spaces 


15872 




<(less than) 


19520 


Immediate space of 3 spaces 


16128 




( 


19776 


Suppress space after printing 







+ 


20032 


Normal spacing is one space after 


printing. 




& 


20544 








$ 


23360 








* 


23616 


TYPER function 


Decimal constant 




) 


23872 


in 


(JCARD) output area 




- (minus) 


24640 


Tabulate 


1344 




/ 


24896 


Shift to black 


5184 




r 


27456 


Carrier return 


5440 




% 


27712 


Backspace 


5696 


Hie 


jh # 


31552 


Line Feed 


9536 




@ 


31808 


Shift to red 


13632 




' (apostrophe) 


32064 








= 


32320 
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OPERATING INSTRUCTIONS 



The procedures set forth 
Guide (C26-3629) and 
C26-3717) should be 
programs. 



in IBM 1130 Card/ Paper Tape Programming System Operator's 
in IBM 1130 DISK Monitor System Reference Manual (C26-3750 or 
followed to execute the sample problems and all user-written 



Switch settings for the 



Input 
Device 



1442 
1442 
1442 
2501 
2501 
2501 



sample problems are as follows : 



Output 
Device 



console printer 

1132 

1403 

console printer 

1132 

1403 



Switches 







down 

up 

up 

down 

up 

up 



down 

down 

up 

down 

down 

up 



down 

down 

down 

up 

up 

up 



Make sure that the switches are set properly before the program begins. 

Note: Sample Problein 2 cannot be executed if Version 1 of the Monitor is being used. 
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HALT LISTING 

Conditions A and B (see list below) have the following meaning: 

A Device not ready. 

B Internal subroutine error. Rerun job. If error persists, verify that the sub- 
routine deck is accurate, using the listings in this manual. If the deck is the 
same, contact your local IBM representative. Save all output. 



IAR 


Accumulator (hex) 


41 


lxxO 


41 


lxxl 


41 


2xx0 


41 


2xxl 


41 


4xx0 


41 


4xxl 


41 


6xx0 


41 


6xxl 


41 


9xx0 


41 


9xxl 



Device 
1442 Card Read Punch 
1442 Card Read Punch 
Console printer or keyboard 
Console printer or keyboard 
2501 Card Reader 
2501 Card Reader 
1132 Printer 
1132 Printer 
1403 Printer 
1403 Printer 



Condition 

A 
B 
A 
B 
A 
B 
A 
B 
A 
B 
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-199- 



READER'S COMMENT FORM 
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COMMENTS 



fold 
fold 



fold 
fold 
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